- 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 Feb 18, 2025@23:21:45 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