GMTSXQ03 ; SLC/JER - XQOR2 for Export w/Health Summary ;1/10/92 14:56
;;2.5;Health Summary;;Dec 16, 1992
XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;12/5/89 09:55 ;
;;6.52;Copyright 1990, DVA;
ACT ;From: STAK^XQOR1
I ^UTILITY("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
S ORNSV="" I ^UTILITY("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"24)"))'[0 S ORNSV=^(24)
K Y S (J,^UTILITY("XQORS",$J,XQORS,"ITM"))=0
ORD S J=$O(@(^UTILITY("XQORS",$J,XQORS,"REF")_"10,"_J_")")) G:J'>0 SET
I $D(@(^UTILITY("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
G ORD
SET S (I,Y)=0
SET1 S Y=$O(Y(Y)) G:Y="" EX S J=0
SET2 S J=$O(Y(Y,J)) G:J="" SET1
S ^UTILITY("XQORS",$J,XQORS,"ITM")=^UTILITY("XQORS",$J,XQORS,"ITM")+1,^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"))=+Y(Y,J)_";"_$P(^UTILITY("XQORS",$J,XQORS,"VPT"),";",2)
I ^UTILITY("XQORS",$J,0,"FILE")=";ORD(101,",+$P(Y(Y,J),"^",4) S ^UTILITY("XQORS",$J,XQORS,"ITM",^UTILITY("XQORS",$J,XQORS,"ITM"),"MA")=$P(Y(Y,J),"^",4)_^UTILITY("XQORS",$J,0,"FILE")
G SET2
EX K ORNSV Q
ACT1 S DA(1)=+^UTILITY("XQORS",$J,XQORS,"VPT"),DA=J N J,X,Y X ORNSV
Q
NUL ;From: STAK^XQOR1
I ^UTILITY("XQORS",$J,0,"FILE")=";ORD(101,",$D(@(^UTILITY("XQORS",$J,XQORS,"REF")_"26)"))'[0 S X=^(26) X:$L(X) X
S ^UTILITY("XQORS",$J,XQORS,"ITM")=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSXQ03 1480 printed Dec 13, 2024@02:01:06 Page 2
GMTSXQ03 ; SLC/JER - XQOR2 for Export w/Health Summary ;1/10/92 14:56
+1 ;;2.5;Health Summary;;Dec 16, 1992
XQOR2 ; SLC/KCM - Process Extended Actions, Protocols ;12/5/89 09:55 ;
+1 ;;6.52;Copyright 1990, DVA;
ACT ;From: STAK^XQOR1
+1 IF ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
IF $DATA(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"26)"))'[0
SET X=^(26)
if $LENGTH(X)
XECUTE X
+2 SET ORNSV=""
IF ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
IF $DATA(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"24)"))'[0
SET ORNSV=^(24)
+3 KILL Y
SET (J,^UTILITY("XQORS",$JOB,XQORS,"ITM"))=0
ORD SET J=$ORDER(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"10,"_J_")"))
if J'>0
GOTO SET
+1 IF $DATA(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"10,"_J_",0)"))
SET X=^(0)
IF +X
if $LENGTH(ORNSV)
DO ACT1
IF $TEST
SET Y=$SELECT(+$PIECE(X,"^",3):+$PIECE(X,"^",3),1:1000+J)
SET Y(Y,J)=X
+2 GOTO ORD
SET SET (I,Y)=0
SET1 SET Y=$ORDER(Y(Y))
if Y=""
GOTO EX
SET J=0
SET2 SET J=$ORDER(Y(Y,J))
if J=""
GOTO SET1
+1 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM")=^UTILITY("XQORS",$JOB,XQORS,"ITM")+1
SET ^UTILITY("XQORS",$JOB,XQORS,"ITM",^UTILITY("XQORS",$JOB,XQORS,"ITM"))=+Y(Y,J)_";"_$PIECE(^UTILITY("XQORS",$JOB,XQORS,"VPT"),";",2)
+2 IF ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
IF +$PIECE(Y(Y,J),"^",4)
SET ^UTILITY("XQORS",$JOB,XQORS,"ITM",^UTILITY("XQORS",$JOB,XQORS,"ITM"),"MA")=$PIECE(Y(Y,J),"^",4)_^UTILITY("XQORS",$JOB,0,"FILE")
+3 GOTO SET2
EX KILL ORNSV
QUIT
ACT1 SET DA(1)=+^UTILITY("XQORS",$JOB,XQORS,"VPT")
SET DA=J
NEW J,X,Y
XECUTE ORNSV
+1 QUIT
NUL ;From: STAK^XQOR1
+1 IF ^UTILITY("XQORS",$JOB,0,"FILE")=";ORD(101,"
IF $DATA(@(^UTILITY("XQORS",$JOB,XQORS,"REF")_"26)"))'[0
SET X=^(26)
if $LENGTH(X)
XECUTE X
+2 SET ^UTILITY("XQORS",$JOB,XQORS,"ITM")=0
+3 QUIT
