ROUTINE XQOR2**

ROUTINE XQOR2

Listing

XQOR2

XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;8/23/91  10:33 ;
     ;;8.0;KERNEL;;Jul 10, 1995

ACT

ACT ;From: STAK^XQOR1
    ;; D0 == ^TMP("XQORS",$J,XQORS,"REF")
    ;; ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;;
    I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X

    ;; ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^
    ;;  saved into lvar ORNSV (used later in ACT1 called from ORD+1)
    S ORNSV="" I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
    ;
    K Y S (J,^TMP("XQORS",$J,XQORS,"ITM"))=0

ORD

    ;; $O loop thru ITEM Multiple most commonly in PROTOCOL FILE -- could be OPTION FILE
    ;; ^ORD(101,D0,10,0)=^101.01PA^^  (#10) ITEM
    ;; ^ORD(101,D0,10,D1,0)=  (#.01) ITEM [1P:101] ^ (#2) MNEMONIC [2F] ^
    ;;            ==>(#3) SEQUENCE [3N] ^ (#4) MODIFYING ACTION [4P:101] ^
    ;;            ==>(#5) FORMAT CODE [5S] ^ (#6) DISPLAY NAME [6F] ^
    ;; ^ORD(101,D0,10,D1,1)=  (#11) PROMPT [1F] ^ (#12) DEFAULT [2F] ^
    ;;            ==>(#13) HELP [3F] ^ (#14) MODE [4F] ^
    ;;
ORD S J=$O(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
    ;;
    ;; Note ORNSV code screens entries in subroutine ACT1
    I $D(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",0)")) S X=^(0) I +X D:$L(ORNSV) ACT1 I $T S Y=$S(+$P(X,"^",3):+$P(X,"^",3),1:1000+J),Y(Y,J)=X
    ;; and get next one 
    G ORD

SET

SET  S (I,Y)=0
     ;; NOTE: @FallThru

SET1

SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
     ;; NOTE: @FallThru

SET2

SET2 S J=$O(Y(Y,J)) G:J="" SET1
     S ^TMP("XQORS",$J,XQORS,"ITM")=^TMP("XQORS",$J,XQORS,"ITM")+1, ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"))=+Y(Y,J)_";"_$P(^TMP("XQORS",$J,XQORS,"VPT"),";",2)
     S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"IEN")=J
     I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",+$P(Y(Y,J),"^",4) S ^TMP("XQORS",$J,XQORS,"ITM",^TMP("XQORS",$J,XQORS,"ITM"),"MA")=$P(Y(Y,J),"^",4)_^TMP("XQORS",$J,0,"FILE")
     I $L($P($G(@(^TMP("XQORS",$J,XQORS,"REF")_"10,"_J_",1)")),"^")) S ^TMP("XQORS",$J,XQORS,"PMT",$$UP($P(^(1),"^")),^TMP("XQORS",$J,XQORS,"ITM"))=""
     G SET2

EX

   ;; kill off ORNSV ( ^ORD(101,D0,24)=  (#24) SCREEN [E1,245K] ^ )
EX K ORNSV Q

ACT1

; note: caller depends on $TEST being set by Xecuting ORNSV
;;      Note context is lvars DA, DA(1)
;;                  NOT lvars D0, D1
ACT1 N DA S DA(1)=+^TMP("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
     Q

NUL

NUL ;From: STAK^XQOR1
    ;; if we are in the PROTOCOL file,
    ;; then ^ORD(101,D0,26)=  (#26) HEADER [E1,245K] ^
    ;; Xecute it
    ;; and zero out the ITM count
    I ^TMP("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^TMP("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
    S ^TMP("XQORS",$J,XQORS,"ITM")=0
    Q

UP

UP(X) Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")