- 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
- 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
