GMRGEDA ;CISC/RM-PATIENT DATA EDIT (cont.) ;5/28/92
;;3.0;Text Generator;;Jan 24, 1996
JUMP ;
S DX=$S($X'>IOM:$X,1:$X-IOM),DY=0 X ^%ZOSF("XY") S X=$P(GMRGS,"^^",2),DIC="^GMRD(124.2,",DIC(0)="EZS",DIC("S")="I +Y'=+GMRGTERM",D="C" D IX^DIC K DIC
I +Y'>0 S:$D(DTOUT) GMRGOUT=1 Q:GMRGOUT!$D(DUOUT) W !?5,"Invalid choice, try again.",!!?5,"Press return to continue " R X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=1 Q
I $D(^GMR(124.3,GMRGPDA,1,"ALIST",+Y)) D SETSLP G KEEP
W !!,"Because '",$P(Y(0),"^"),"' is not part of the",!,"patient data, it must be ""linked"" in via a pathway.",!,"The following list will be a list of pathways to choose from.",!,"To continue with this jump, you must pick a pathway."
W !!,"Enter return to continue, ^ to abort the jump " R X:DTIME S:X="^^"!'$T GMRGOUT=1 Q:GMRGOUT!(X="^")
K GMRGPATH S GMRG0(0)=+Y,GMRGSELP="",(GMRG0,GMRGPATH)=0,GMRGPATH(0)=GMRG0(0) W !!,"...Excuse me while I perform some necessary calculations..." D PATH
I 'GMRGPATH W $C(7),!?5,"Cannot jump, no valid paths were found.",!!?5,"Press return to continue " R X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=1 G KEEP
W @IOF S GMRGLIST=0 F GMRG1=0:0 S GMRG1=$O(^TMP($J,"GMRGPATH",GMRG1)) Q:GMRG1'>0 D LPTH Q:GMRGOUT!GMRGSELP
D:'GMRGOUT&'GMRGSELP PICK S:GMRG3'="^^" GMRGOUT=0 I GMRGSELP S GMRGSELP=$S($D(^TMP($J,"GMRGLIST",GMRGSELP)):^(GMRGSELP),1:"")
KEEP K ^TMP($J,"GMRGPATH"),^TMP($J,"GMRGLIST") Q:GMRGOUT!'GMRGSELP S GMRGUSL(+Y_"*")=GMRGSELP
Q
PATH ; CALCULATE ALL PATHS
F GMRG1=0:0 S GMRG1=$O(^GMRD(124.2,"AKID",GMRG0(GMRG0),GMRG1)) Q:GMRG1'>0 I $D(^(GMRG1,0)) D RECPAT
S GMRG1=GMRG0(GMRG0),GMRG0=GMRG0-1,GMRGPATH(0)=$P(GMRGPATH(0),"^",2,$L(GMRGPATH(0),"^"))
Q
RECPAT ;
I +GMRGRT=GMRG1!$D(^GMR(124.3,GMRGPDA,1,"ALIST",GMRG1)) S GMRGPATH=GMRGPATH+1,^TMP($J,"GMRGPATH",$L(GMRGPATH(0),"^"),GMRG1,GMRGPATH)=GMRGPATH(0) W:'$R(100) "." Q
S GMRGPATH(0)=GMRG1_"^"_GMRGPATH(0),GMRG0=GMRG0+1,GMRG0(GMRG0)=GMRG1
D PATH
Q
LPTH ;
F GMRG0(1)=0:0 S GMRG0(1)=$O(^TMP($J,"GMRGPATH",GMRG1,GMRG0(1))) Q:GMRG0(1)'>0!GMRGOUT!GMRGSELP F GMRG0=0:0 S GMRG0=$O(^TMP($J,"GMRGPATH",GMRG1,GMRG0(1),GMRG0)) Q:GMRG0'>0 D SELPAT Q:GMRGOUT!GMRGSELP
Q
SELPAT ;
S GMRG0(0)=$S($D(^TMP($J,"GMRGPATH",GMRG1,GMRG0(1),GMRG0)):^(GMRG0),1:"") Q:GMRG0(0)=""
I ($Y+$L(GMRG0(0),"^")+1)>(IOSL-3) D PICK I GMRGOUT!GMRGSELP Q
S GMRGLIST=GMRGLIST+1,^TMP($J,"GMRGLIST",GMRGLIST)=GMRG0(1)_"^"_GMRG0(0) K ^TMP($J,"GMRGPATH",GMRG1,GMRG0(1),GMRG0)
W !,$J(GMRGLIST,3),". ",$S($D(^GMRD(124.2,+GMRG0(1),0)):$P(^(0),"^"),1:"") F GMRG0(2)=1:1:$L(GMRG0(0),"^") W !?(GMRG0(2)+2*2+1),$S($D(^GMRD(124.2,+$P(GMRG0(0),"^",GMRG0(2)),0)):$P(^(0),"^"),1:"")
Q
PICK S GMRG3="" W !!,"Select a pathway, Choose a number 1-",GMRGLIST,", or enter return to see more: " R X:DTIME S:'$T!(X="^^") GMRG3="^^",X="^" S:X="^" GMRGOUT=1 I X=""!GMRGOUT W:X="" @IOF Q
I X=+X,$D(^TMP($J,"GMRGLIST",X)) S GMRGSELP=X Q
W !?4,$C(7),"ENTER A VALID NUMBER BETWEEN 1 AND ",GMRGLIST
G PICK
SETSLP ;
I +Y=+GMRGRT S GMRGSELP=+Y Q
S GMRGLIST=0 F X=0:0 S X=$O(^GMRD(124.2,"AKID",+Y,X)) Q:X'>0 I $D(^(X,0)),$D(^GMR(124.3,GMRGPDA,1,"ALIST",X)) S GMRGLIST=GMRGLIST+1,GMRGLIST(GMRGLIST)=X
I GMRGLIST'>0 S GMRGSELP="" Q
I GMRGLIST>1 D CHC S:'GMRGLIST GMRGSELP="" Q:GMRGOUT!'GMRGLIST
I GMRGLIST=1 S GMRGLIST=GMRGLIST(1)
S GMRGSELP=GMRGLIST_"^"_+Y
Q
CHC ;
W !!!
F X=0:0 S X=$O(GMRGLIST(X)) Q:X'>0 W ?4,$J(X,2)," ",$S($D(^GMRD(124.2,+GMRGLIST(X),0)):$P(^(0),"^"),1:""),!?7,"PARENT: " F Z=0:0 S Z=$O(^GMRD(124.2,"AKID",+GMRGLIST(X),Z)) Q:Z'>0 D
. I $D(^(Z,0)) W ?15,$S($D(^GMRD(124.2,+Z,0)):$P(^(0),"^"),1:""),!
. Q
W !,"The term you wish to jump to can be reached from multiple paths.",!,"Please choose the number (1-"_GMRGLIST_") of the corresponding path you wish to use: "
R X:DTIME S:X="^^"!'$T X="^" S:X="^" GMRGOUT=1 S:X="" GMRGLIST=X Q:'GMRGLIST!GMRGOUT I X<1!(X>GMRGLIST) W !?3,$C(7),"PLEASE CHOOSE A NUMBER BETWEEN 1 AND ",GMRGLIST G CHC
S GMRGLIST=GMRGLIST(X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGEDA 3962 printed Dec 13, 2024@01:55:22 Page 2
GMRGEDA ;CISC/RM-PATIENT DATA EDIT (cont.) ;5/28/92
+1 ;;3.0;Text Generator;;Jan 24, 1996
JUMP ;
+1 SET DX=$SELECT($X'>IOM:$X,1:$X-IOM)
SET DY=0
XECUTE ^%ZOSF("XY")
SET X=$PIECE(GMRGS,"^^",2)
SET DIC="^GMRD(124.2,"
SET DIC(0)="EZS"
SET DIC("S")="I +Y'=+GMRGTERM"
SET D="C"
DO IX^DIC
KILL DIC
+2 IF +Y'>0
if $DATA(DTOUT)
SET GMRGOUT=1
if GMRGOUT!$DATA(DUOUT)
QUIT
WRITE !?5,"Invalid choice, try again.",!!?5,"Press return to continue "
READ X:DTIME
if X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
QUIT
+3 IF $DATA(^GMR(124.3,GMRGPDA,1,"ALIST",+Y))
DO SETSLP
GOTO KEEP
+4 WRITE !!,"Because '",$PIECE(Y(0),"^"),"' is not part of the",!,"patient data, it must be ""linked"" in via a pathway.",!,"The following list will be a list of pathways to choose from.",!,"To continue with this jump, you must pick a pathway."
+5 WRITE !!,"Enter return to continue, ^ to abort the jump "
READ X:DTIME
if X="^^"!'$TEST
SET GMRGOUT=1
if GMRGOUT!(X="^")
QUIT
+6 KILL GMRGPATH
SET GMRG0(0)=+Y
SET GMRGSELP=""
SET (GMRG0,GMRGPATH)=0
SET GMRGPATH(0)=GMRG0(0)
WRITE !!,"...Excuse me while I perform some necessary calculations..."
DO PATH
+7 IF 'GMRGPATH
WRITE $CHAR(7),!?5,"Cannot jump, no valid paths were found.",!!?5,"Press return to continue "
READ X:DTIME
if X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
GOTO KEEP
+8 WRITE @IOF
SET GMRGLIST=0
FOR GMRG1=0:0
SET GMRG1=$ORDER(^TMP($JOB,"GMRGPATH",GMRG1))
if GMRG1'>0
QUIT
DO LPTH
if GMRGOUT!GMRGSELP
QUIT
+9 if 'GMRGOUT&'GMRGSELP
DO PICK
if GMRG3'="^^"
SET GMRGOUT=0
IF GMRGSELP
SET GMRGSELP=$SELECT($DATA(^TMP($JOB,"GMRGLIST",GMRGSELP)):^(GMRGSELP),1:"")
KEEP KILL ^TMP($JOB,"GMRGPATH"),^TMP($JOB,"GMRGLIST")
if GMRGOUT!'GMRGSELP
QUIT
SET GMRGUSL(+Y_"*")=GMRGSELP
+1 QUIT
PATH ; CALCULATE ALL PATHS
+1 FOR GMRG1=0:0
SET GMRG1=$ORDER(^GMRD(124.2,"AKID",GMRG0(GMRG0),GMRG1))
if GMRG1'>0
QUIT
IF $DATA(^(GMRG1,0))
DO RECPAT
+2 SET GMRG1=GMRG0(GMRG0)
SET GMRG0=GMRG0-1
SET GMRGPATH(0)=$PIECE(GMRGPATH(0),"^",2,$LENGTH(GMRGPATH(0),"^"))
+3 QUIT
RECPAT ;
+1 IF +GMRGRT=GMRG1!$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",GMRG1))
SET GMRGPATH=GMRGPATH+1
SET ^TMP($JOB,"GMRGPATH",$LENGTH(GMRGPATH(0),"^"),GMRG1,GMRGPATH)=GMRGPATH(0)
if '$RANDOM(100)
WRITE "."
QUIT
+2 SET GMRGPATH(0)=GMRG1_"^"_GMRGPATH(0)
SET GMRG0=GMRG0+1
SET GMRG0(GMRG0)=GMRG1
+3 DO PATH
+4 QUIT
LPTH ;
+1 FOR GMRG0(1)=0:0
SET GMRG0(1)=$ORDER(^TMP($JOB,"GMRGPATH",GMRG1,GMRG0(1)))
if GMRG0(1)'>0!GMRGOUT!GMRGSELP
QUIT
FOR GMRG0=0:0
SET GMRG0=$ORDER(^TMP($JOB,"GMRGPATH",GMRG1,GMRG0(1),GMRG0))
if GMRG0'>0
QUIT
DO SELPAT
if GMRGOUT!GMRGSELP
QUIT
+2 QUIT
SELPAT ;
+1 SET GMRG0(0)=$SELECT($DATA(^TMP($JOB,"GMRGPATH",GMRG1,GMRG0(1),GMRG0)):^(GMRG0),1:"")
if GMRG0(0)=""
QUIT
+2 IF ($Y+$LENGTH(GMRG0(0),"^")+1)>(IOSL-3)
DO PICK
IF GMRGOUT!GMRGSELP
QUIT
+3 SET GMRGLIST=GMRGLIST+1
SET ^TMP($JOB,"GMRGLIST",GMRGLIST)=GMRG0(1)_"^"_GMRG0(0)
KILL ^TMP($JOB,"GMRGPATH",GMRG1,GMRG0(1),GMRG0)
+4 WRITE !,$JUSTIFY(GMRGLIST,3),". ",$SELECT($DATA(^GMRD(124.2,+GMRG0(1),0)):$PIECE(^(0),"^"),1:"")
FOR GMRG0(2)=1:1:$LENGTH(GMRG0(0),"^")
WRITE !?(GMRG0(2)+2*2+1),$SELECT($DATA(^GMRD(124.2,+$PIECE(GMRG0(0),"^",GMRG0(2)),0)):$PIECE(^(0),"^"),1:"")
+5 QUIT
PICK SET GMRG3=""
WRITE !!,"Select a pathway, Choose a number 1-",GMRGLIST,", or enter return to see more: "
READ X:DTIME
if '$TEST!(X="^^")
SET GMRG3="^^"
SET X="^"
if X="^"
SET GMRGOUT=1
IF X=""!GMRGOUT
if X=""
WRITE @IOF
QUIT
+1 IF X=+X
IF $DATA(^TMP($JOB,"GMRGLIST",X))
SET GMRGSELP=X
QUIT
+2 WRITE !?4,$CHAR(7),"ENTER A VALID NUMBER BETWEEN 1 AND ",GMRGLIST
+3 GOTO PICK
SETSLP ;
+1 IF +Y=+GMRGRT
SET GMRGSELP=+Y
QUIT
+2 SET GMRGLIST=0
FOR X=0:0
SET X=$ORDER(^GMRD(124.2,"AKID",+Y,X))
if X'>0
QUIT
IF $DATA(^(X,0))
IF $DATA(^GMR(124.3,GMRGPDA,1,"ALIST",X))
SET GMRGLIST=GMRGLIST+1
SET GMRGLIST(GMRGLIST)=X
+3 IF GMRGLIST'>0
SET GMRGSELP=""
QUIT
+4 IF GMRGLIST>1
DO CHC
if 'GMRGLIST
SET GMRGSELP=""
if GMRGOUT!'GMRGLIST
QUIT
+5 IF GMRGLIST=1
SET GMRGLIST=GMRGLIST(1)
+6 SET GMRGSELP=GMRGLIST_"^"_+Y
+7 QUIT
CHC ;
+1 WRITE !!!
+2 FOR X=0:0
SET X=$ORDER(GMRGLIST(X))
if X'>0
QUIT
WRITE ?4,$JUSTIFY(X,2)," ",$SELECT($DATA(^GMRD(124.2,+GMRGLIST(X),0)):$PIECE(^(0),"^"),1:""),!?7,"PARENT: "
FOR Z=0:0
SET Z=$ORDER(^GMRD(124.2,"AKID",+GMRGLIST(X),Z))
if Z'>0
QUIT
Begin DoDot:1
+3 IF $DATA(^(Z,0))
WRITE ?15,$SELECT($DATA(^GMRD(124.2,+Z,0)):$PIECE(^(0),"^"),1:""),!
+4 QUIT
End DoDot:1
+5 WRITE !,"The term you wish to jump to can be reached from multiple paths.",!,"Please choose the number (1-"_GMRGLIST_") of the corresponding path you wish to use: "
+6 READ X:DTIME
if X="^^"!'$TEST
SET X="^"
if X="^"
SET GMRGOUT=1
if X=""
SET GMRGLIST=X
if 'GMRGLIST!GMRGOUT
QUIT
IF X<1!(X>GMRGLIST)
WRITE !?3,$CHAR(7),"PLEASE CHOOSE A NUMBER BETWEEN 1 AND ",GMRGLIST
GOTO CHC
+7 SET GMRGLIST=GMRGLIST(X)
+8 QUIT
