GMRGED1 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;9/1/95
;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO PRINT, CHOOSE, PROCESS SELECTIONS FOR THE AGGY TERM
; IDENTIFIED IN GMRGTERM
K GMRGUSL,GMRGSTAR,GMRGHPRT D SETSEL^GMRGED4 S GMRGMAX=$S($P(GMRGTERM(0),"^",7):$P(GMRGTERM(0),"^",7),1:99),GMRGSEL=GMRGCNT-1,(GMRGSTAR(0,1),GMRGSTAR,GMRGJUMP)=0,GMRGSTAR(2)=1
REP S GMRGDN=0 F GMRGSLY(0)=1:1 D REPRINT^GMRGEDB Q:GMRGOUT!GMRGDN!GMRGJUMP
Q:GMRGOUT ;S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP RT
S GMRGREP=0 D:'GMRGJUMP SEL G:GMRGREP REP ;D:$D(XRTL)&'GMRGOUT T0^%ZOSV ; START RT
Q:GMRGOUT!GMRGUP D EN1^GMRGED2 S GMRGUP=$S(GMRGNORD#2:1,1:0) G EN1:'GMRGOUT&'GMRGUP D SETSEL^GMRGED4 S GMRGUP=GMRGNORD#2
Q
SEL S (GMRGPSEL,GMRGUP)=0 W !! D PROMPT^GMRGED3 R GMRGS:DTIME
S:GMRGS="^"!(GMRGS="^^")!'$T GMRGOUT=1 S:GMRGS=""&'$O(GMRGUSL(0)) GMRGUP=1
Q:GMRGUP!GMRGOUT
PSEL S (GMRGMSR,GMRGOOD)=0 K GMRGQUSL I GMRGS'?3"?".E,GMRGS?1"?".E S XQH=$S(GMRGS?1"??".E:"GMRG-COMPLETE SELECTION HELP",1:"GMRG-SELECTIONS") D EN^XQH K XQH S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
I GMRGS="^R"!(GMRGS="^r") S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
I GMRGS="-",GMRGSTAR(2)'>1&'GMRGPSEL!(GMRGSTAR(2)=1) W !!,$C(7),"There is no previous screen of selections." G:GMRGSTAR(2)'>1&'GMRGPSEL SEL S GMRGMSR=1,GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q
I GMRGS="-" S GMRGSTAR(2)=GMRGSTAR(2)-1,GMRGREP=1,GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q
I GMRGS?3"?".E D PRTDEF^GMRGED4 Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
I GMRGS="^D"!(GMRGS="^d") D DEMPAT^GMRGRUT2 Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
I GMRGS="^P"!(GMRGS="^p") D NOW^%DTC S GMRGPDT=%,GMRGPROU="D "_$S(GMRGSITE("P")'="":GMRGSITE("P"),1:"EN1^GMRGPUTL") X GMRGPROU Q:GMRGOUT S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
I GMRGS="^T"!(GMRGS="^t") S GMRGTOP=1-GMRGTOP W !!,"The narrative display is ",$S(GMRGTOP:"on",1:"off"),".",!!,"Press return to continue " R X:DTIME S:X="^"!(X="^^")!'$T GMRGOUT=1 S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGOUT!GMRGPSEL G SEL
I GMRGS="^H"!(GMRGS="^h") D EN1^GMRGRUT4,EN2^GMRGRUT4 S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)) Q:GMRGPSEL D REPRINT^GMRGEDB Q:GMRGOUT G SEL
; THE FOLLOWING CODE HAS BEEN COMMENTED OUT BECAUSE JUMPING AND
; SCRIPTING HAVE BEEN PULLED BACK FROM V3. HOWEVER, THEY MAY BE
; UNCOMMENTED IN A PATCH, AND SO THEY ARE LEFT IN THE ROUTINE.
;I GMRGS?1"^^".E,GMRGS'?1"^^^".E D JUMP^GMRGEDA S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
;I GMRGS?1"[".E D FNDTMP^GMRGEDB S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
S GMRGOOD=1 D VALIDATE^GMRGED3 I 'GMRGOOD W !?5,$C(7),"Please enter a valid list of selections,",!?5,"type '?' or '??' if you need more help." S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGMSR=1,GMRG1=GMRGSTAR(1) Q:GMRGPSEL G SEL
S GMRG2=$S($D(GMRGUSL("A"))!$D(GMRGQUSL("A")):1,'$D(^GMR(124.3,GMRGPDA,1,+$P(GMRGPRC(0),"^",2),"ADD")):0,$P(^("ADD"),"^")="":0,1:1)
F GMRG1=0:0 S GMRG1=$O(GMRGSEL(GMRG1)) Q:GMRG1'>0 I $S('$D(GMRGQUSL(GMRG1))&'$D(GMRGUSL(GMRG1)):$S($P(GMRGSEL(GMRG1),"^",3)=1:1,1:0),$D(GMRGQUSL(GMRG1)):$S(GMRGQUSL(GMRG1)'="@":1,1:0),GMRGUSL(GMRG1)'="@":1,1:0) S GMRG2=GMRG2+1
I GMRG2>GMRGMAX W:$P(GMRGTERM(0),"^",12)'>1 !?3,$C(7),"THE MAXIMUM NUMBER OF SELECTIONS YOU CAN HAVE FOR THIS TERM IS ",GMRGMAX,"."
I W:$P(GMRGTERM(0),"^",12)'>1 !?3,"YOU HAVE EXCEEDED THIS MAXIMUM BY ",GMRG2-GMRGMAX," SELECTION"_$E("S",1,GMRG2-GMRGMAX-1)_", PLEASE CORRECT."
I S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGOOD=0,GMRGMSR=1,GMRG1=GMRGSTAR(1) Q:GMRGPSEL G SEL
S GMRGQ="",GMRG1=GMRGSTAR(1) F GMRGQ(0)=0:0 S GMRGQ=$O(GMRGQUSL(GMRGQ)) Q:GMRGQ="" S GMRGUSL(GMRGQ)=GMRGQUSL(GMRGQ)
I GMRGS[",",$P(GMRGS,",",$L(GMRGS,","))="" S X=$P(^TMP($J,"GMRGLVL",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3),$P(^(+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)=(X\10)_1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED1 4150 printed Oct 16, 2024@17:55:56 Page 2
GMRGED1 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;9/1/95
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO PRINT, CHOOSE, PROCESS SELECTIONS FOR THE AGGY TERM
+1 ; IDENTIFIED IN GMRGTERM
+2 KILL GMRGUSL,GMRGSTAR,GMRGHPRT
DO SETSEL^GMRGED4
SET GMRGMAX=$SELECT($PIECE(GMRGTERM(0),"^",7):$PIECE(GMRGTERM(0),"^",7),1:99)
SET GMRGSEL=GMRGCNT-1
SET (GMRGSTAR(0,1),GMRGSTAR,GMRGJUMP)=0
SET GMRGSTAR(2)=1
REP SET GMRGDN=0
FOR GMRGSLY(0)=1:1
DO REPRINT^GMRGEDB
if GMRGOUT!GMRGDN!GMRGJUMP
QUIT
+1 ;S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; STOP RT
if GMRGOUT
QUIT
+2 ;D:$D(XRTL)&'GMRGOUT T0^%ZOSV ; START RT
SET GMRGREP=0
if 'GMRGJUMP
DO SEL
if GMRGREP
GOTO REP
+3 if GMRGOUT!GMRGUP
QUIT
DO EN1^GMRGED2
SET GMRGUP=$SELECT(GMRGNORD#2:1,1:0)
if 'GMRGOUT&'GMRGUP
GOTO EN1
DO SETSEL^GMRGED4
SET GMRGUP=GMRGNORD#2
+4 QUIT
SEL SET (GMRGPSEL,GMRGUP)=0
WRITE !!
DO PROMPT^GMRGED3
READ GMRGS:DTIME
+1 if GMRGS="^"!(GMRGS="^^")!'$TEST
SET GMRGOUT=1
if GMRGS=""&'$ORDER(GMRGUSL(0))
SET GMRGUP=1
+2 if GMRGUP!GMRGOUT
QUIT
PSEL SET (GMRGMSR,GMRGOOD)=0
KILL GMRGQUSL
IF GMRGS'?3"?".E
IF GMRGS?1"?".E
SET XQH=$SELECT(GMRGS?1"??".E:"GMRG-COMPLETE SELECTION HELP",1:"GMRG-SELECTIONS")
DO EN^XQH
KILL XQH
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+1 IF GMRGS="^R"!(GMRGS="^r")
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+2 IF GMRGS="-"
IF GMRGSTAR(2)'>1&'GMRGPSEL!(GMRGSTAR(2)=1)
WRITE !!,$CHAR(7),"There is no previous screen of selections."
if GMRGSTAR(2)'>1&'GMRGPSEL
GOTO SEL
SET GMRGMSR=1
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
QUIT
+3 IF GMRGS="-"
SET GMRGSTAR(2)=GMRGSTAR(2)-1
SET GMRGREP=1
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
QUIT
+4 IF GMRGS?3"?".E
DO PRTDEF^GMRGED4
if GMRGOUT
QUIT
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+5 IF GMRGS="^D"!(GMRGS="^d")
DO DEMPAT^GMRGRUT2
if GMRGOUT
QUIT
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+6 IF GMRGS="^P"!(GMRGS="^p")
DO NOW^%DTC
SET GMRGPDT=%
SET GMRGPROU="D "_$SELECT(GMRGSITE("P")'="":GMRGSITE("P"),1:"EN1^GMRGPUTL")
XECUTE GMRGPROU
if GMRGOUT
QUIT
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+7 IF GMRGS="^T"!(GMRGS="^t")
SET GMRGTOP=1-GMRGTOP
WRITE !!,"The narrative display is ",$SELECT(GMRGTOP:"on",1:"off"),".",!!,"Press return to continue "
READ X:DTIME
if X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGOUT!GMRGPSEL
QUIT
GOTO SEL
+8 IF GMRGS="^H"!(GMRGS="^h")
DO EN1^GMRGRUT4
DO EN2^GMRGRUT4
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
if GMRGPSEL
QUIT
DO REPRINT^GMRGEDB
if GMRGOUT
QUIT
GOTO SEL
+9 ; THE FOLLOWING CODE HAS BEEN COMMENTED OUT BECAUSE JUMPING AND
+10 ; SCRIPTING HAVE BEEN PULLED BACK FROM V3. HOWEVER, THEY MAY BE
+11 ; UNCOMMENTED IN A PATCH, AND SO THEY ARE LEFT IN THE ROUTINE.
+12 ;I GMRGS?1"^^".E,GMRGS'?1"^^^".E D JUMP^GMRGEDA S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
+13 ;I GMRGS?1"[".E D FNDTMP^GMRGEDB S:'GMRGOUT&$D(GMRGUSL) GMRGJUMP=1 S:'GMRGJUMP GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2)),GMRGREP=GMRGREP+1 Q
+14 SET GMRGOOD=1
DO VALIDATE^GMRGED3
IF 'GMRGOOD
WRITE !?5,$CHAR(7),"Please enter a valid list of selections,",!?5,"type '?' or '??' if you need more help."
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
SET GMRGMSR=1
SET GMRG1=GMRGSTAR(1)
if GMRGPSEL
QUIT
GOTO SEL
+15 SET GMRG2=$SELECT($DATA(GMRGUSL("A"))!$DATA(GMRGQUSL("A")):1,'$DATA(^GMR(124.3,GMRGPDA,1,+$PIECE(GMRGPRC(0),"^",2),"ADD")):0,$PIECE(^("ADD"),"^")="":0,1:1)
+16 FOR GMRG1=0:0
SET GMRG1=$ORDER(GMRGSEL(GMRG1))
if GMRG1'>0
QUIT
IF $SELECT('$DATA(GMRGQUSL(GMRG1))&'$DATA(GMRGUSL(GMRG1)):$SELECT($PIECE(GMRGSEL(GMRG1),"^",3)=1:1,1:0),$DATA(GMRGQUSL(GMRG1)):$SELECT(GMRGQUSL(GMRG1)'="@":1,1:0),GMRGUSL(GMRG1)'="@":1,1:0)
SET GMRG2=GMRG2+1
+17 IF GMRG2>GMRGMAX
if $PIECE(GMRGTERM(0),"^",12)'>1
WRITE !?3,$CHAR(7),"THE MAXIMUM NUMBER OF SELECTIONS YOU CAN HAVE FOR THIS TERM IS ",GMRGMAX,"."
+18 IF $TEST
if $PIECE(GMRGTERM(0),"^",12)'>1
WRITE !?3,"YOU HAVE EXCEEDED THIS MAXIMUM BY ",GMRG2-GMRGMAX," SELECTION"_$EXTRACT("S",1,GMRG2-GMRGMAX-1)_", PLEASE CORRECT."
+19 IF $TEST
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
SET GMRGOOD=0
SET GMRGMSR=1
SET GMRG1=GMRGSTAR(1)
if GMRGPSEL
QUIT
GOTO SEL
+20 SET GMRGQ=""
SET GMRG1=GMRGSTAR(1)
FOR GMRGQ(0)=0:0
SET GMRGQ=$ORDER(GMRGQUSL(GMRGQ))
if GMRGQ=""
QUIT
SET GMRGUSL(GMRGQ)=GMRGQUSL(GMRGQ)
+21 IF GMRGS[","
IF $PIECE(GMRGS,",",$LENGTH(GMRGS,","))=""
SET X=$PIECE(^TMP($JOB,"GMRGLVL",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)
SET $PIECE(^(+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)=(X\10)_1
+22 QUIT
