GMRGEDB ;CISC/RM,RTK-PATIENT DATA EDIT (cont.) ;8/23/93
;;3.0;Text Generator;;Jan 24, 1996
REPRINT ; PRINT MENU SELECTIONS USING GMRGSEL ARRAY.
I '(GMRGNORD\10) X:$D(^GMRD(124.2,$P(GMRGTERM,"^"),7)) ^(7) Q:GMRGOUT S GMRGNORD=10+GMRGNORD,$P(^TMP($J,"GMRGLVL",+GMRGLVL,$P(GMRGLVL(+GMRGLVL),"^"),$P(GMRGLVL(+GMRGLVL,$P(GMRGLVL(+GMRGLVL),"^")),"^")),"^",3)=GMRGNORD D HDR
D:$P(GMRGTERM(0),"^",11)&(GMRGSTAR(2)=1)&GMRGTOP EN1^GMRGED9 Q:GMRGOUT W @IOF,!,GMRGLIN("*"),!,GMRGVNAM," ",GMRGVSSN,?50,GMRGVDOB," (",GMRGVAGE,") PAGE: ",GMRGSTAR(2)
S GMRGTLC=$Y F X=0:0 S X=$O(^TMP($J,"GMRGHDR",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL)),X)) Q:X'>0 I $D(^(X))#2 W !,^(X)
S:'$P(GMRGTERM(0),"^",10) GMRGSTAR(0,GMRGSTAR(2))=GMRGSTAR W !! S GMRGXPRT=$P(GMRGTERM,"^",2),GMRGXPRT(0)=$S($D(GMRGPRC(0)):$P(GMRGPRC(0),"^",3),1:"") D EN1^GMRGRUT2 W !,GMRGLIN("*"),! S GMRGTLC=$Y-GMRGTLC
S GMRGLIN=3+GMRGTLC
I '$P(GMRGTERM(0),"^",10) F GMRG1=GMRGSTAR:0 S GMRG1=$O(GMRGSEL(GMRG1)) S:GMRG1'>0 GMRGDN=1,GMRGSTAR(1)=GMRGSTAR+1 Q:GMRG1'>0 D REPRT^GMRGED4 Q:GMRGOUT!'GMRGLIN ; save for split screen
I $P(GMRGTERM(0),"^",10) D SSC ; save for split screen
I 'GMRGOUT,$P(GMRGTERM(0),"^",9),GMRGDN W !?5,"Additional Text: " I $S($P(GMRGTERM,"^",3)="":0,1:1) D PRAD^GMRGED4
Q
SSC ;
S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
F GMRG1=GMRGSTAR:0 S GMRG1=$O(^TMP($J,"GMR",GMRG1)) S GMRG0=$S('$D(GMRGSTAR(0,GMRGSTAR(2)+1)):0,GMRG1>GMRGSTAR(0,GMRGSTAR(2)+1):1,1:0) S:GMRG1'>0 GMRGDN=1 S:GMRG1'>0!GMRG0 GMRGSTAR(1)=GMRGCNT-1 Q:GMRG1'>0!GMRG0 D SSCR Q:GMRGOUT!'GMRGLIN
I $D(GMRGSTAR(0,GMRGSTAR(2)+1)) S GMRG1=GMRGSTAR(3) D PARSEL^GMRGED4
Q
SSCR ;
S GMRGSTAR=GMRG1-1,I=GMRG1 D PRN^GMRGED8 Q:GMRGOUT!'GMRGLIN
Q
HDR ;
F X=0:0 S X=$O(GMRGHPRT(X)) Q:X'>0 I $D(GMRGHPRT(X))#2 S ^TMP($J,"GMRGHDR",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL)),X)=GMRGHPRT(X)
I GMRGSCRP,'$D(GMRGTPLT) S GMRGUSL(+GMRGRT_"T")=+GMRGRT,GMRGTPLT=GMRGSCRP,GMRGSCRP=0 D EN1^GMRGED2 D SETSEL^GMRGED4 S GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
Q
ADSEL ; IF THE SELECTION HAS BEEN CHOSEN, BUT NOT CURRENTLY ACTIVE IN THE
; FOR THE PLAN, THEN IT WILL BE ADDED WITH ITS ADDED FLAG INDICATING NO
K DA S DA(1)=GMRGPDA,X=$P(GMRGPRC,"^"),DA=$O(^GMR(124.3,DA(1),1,"B",X,0))
I DA'>0 D ADNEW
S GMRGY=1 D EN1^GMRGUTL S $P(GMRGPRC(0),"^",2)=DA,$P(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0),"^",2)=DA
Q:'$P(^GMR(124.3,DA(1),1,DA,0),"^",3) S X=1 F GMRG1=0:0 S GMRG1=$O(^DD(124.31,4,1,GMRG1)) Q:GMRG1'>0 X:$D(^DD(124.31,4,1,GMRG1,2)) ^(2)
D NOADS
Q
NOADS ;
S X=0,$P(^GMR(124.3,DA(1),1,DA,0),"^",3)=X F GMRG1=0:0 S GMRG1=$O(^DD(124.31,4,1,GMRG1)) Q:GMRG1'>0 X:$D(^DD(124.31,4,1,GMRG1,1)) ^(1)
Q
ADNEW ;
S DA=$P(^GMR(124.3,DA(1),1,0),"^",3)+1 F DA=DA:1 Q:'$D(^GMR(124.3,DA(1),1,DA,0))
S ^GMR(124.3,DA(1),1,DA,0)=X,$P(^GMR(124.3,DA(1),1,0),"^",3,4)=DA_"^"_($P(^GMR(124.3,DA(1),1,0),"^",4)+1) F GMRG1=0:0 S GMRG1=$O(^DD(124.31,.01,1,GMRG1)) Q:GMRG1'>0 X:$D(^DD(124.31,.01,1,GMRG1,1)) ^(1)
D NOADS
Q
FNDTMP ; FIND TEMPLATE THAT WILL BE USED IN PLAYBACK SESSION.
I $D(GMRGTPLT) W !!?5,$C(7),"Templates CANNOT nested. You need to finish with the template you",!?5,"are currently using before you can select a new template.",!!,"Press return to continue " R X:DTIME S:'$T!(X="^")!(X="^^") GMRGOUT=1 Q
S X=$P(GMRGS,"[",2,99),DIC="^GMRD(124.4,",DIC(0)="EQMF",DIC("S")="I $P(^(0),U,2)=+GMRGRT" D ^DIC K DIC S:$D(DTOUT)!$D(DUOUT) GMRGOUT=1 I +Y'>0
I +Y'>0 W:'GMRGOUT !!?5,$C(7),"INVALID TEMPLATE SELECTION",!!,"Press return to continue " R X:DTIME S:'$T!(X="^")!(X="^^") GMRGOUT=1 Q
S GMRGTPLT=+Y,GMRGUSL(+GMRGRT_"T")=+GMRGRT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGEDB 3663 printed Dec 13, 2024@01:55:23 Page 2
GMRGEDB ;CISC/RM,RTK-PATIENT DATA EDIT (cont.) ;8/23/93
+1 ;;3.0;Text Generator;;Jan 24, 1996
REPRINT ; PRINT MENU SELECTIONS USING GMRGSEL ARRAY.
+1 IF '(GMRGNORD\10)
if $DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),7))
XECUTE ^(7)
if GMRGOUT
QUIT
SET GMRGNORD=10+GMRGNORD
SET $PIECE(^TMP($JOB,"GMRGLVL",+GMRGLVL,$PIECE(GMRGLVL(+GMRGLVL),"^"),$PIECE(GMRGLVL(+GMRGLVL,$PIECE(GMRGLVL(+GMRGLVL),"^")),"^")),"^",3)=GMRGNORD
DO HDR
+2 if $PIECE(GMRGTERM(0),"^",11)&(GMRGSTAR(2)=1)&GMRGTOP
DO EN1^GMRGED9
if GMRGOUT
QUIT
WRITE @IOF,!,GMRGLIN("*"),!,GMRGVNAM," ",GMRGVSSN,?50,GMRGVDOB," (",GMRGVAGE,") PAGE: ",GMRGSTAR(2)
+3 SET GMRGTLC=$Y
FOR X=0:0
SET X=$ORDER(^TMP($JOB,"GMRGHDR",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL)),X))
if X'>0
QUIT
IF $DATA(^(X))#2
WRITE !,^(X)
+4 if '$PIECE(GMRGTERM(0),"^",10)
SET GMRGSTAR(0,GMRGSTAR(2))=GMRGSTAR
WRITE !!
SET GMRGXPRT=$PIECE(GMRGTERM,"^",2)
SET GMRGXPRT(0)=$SELECT($DATA(GMRGPRC(0)):$PIECE(GMRGPRC(0),"^",3),1:"")
DO EN1^GMRGRUT2
WRITE !,GMRGLIN("*"),!
SET GMRGTLC=$Y-GMRGTLC
+5 SET GMRGLIN=3+GMRGTLC
+6 ; save for split screen
IF '$PIECE(GMRGTERM(0),"^",10)
FOR GMRG1=GMRGSTAR:0
SET GMRG1=$ORDER(GMRGSEL(GMRG1))
if GMRG1'>0
SET GMRGDN=1
SET GMRGSTAR(1)=GMRGSTAR+1
if GMRG1'>0
QUIT
DO REPRT^GMRGED4
if GMRGOUT!'GMRGLIN
QUIT
+7 ; save for split screen
IF $PIECE(GMRGTERM(0),"^",10)
DO SSC
+8 IF 'GMRGOUT
IF $PIECE(GMRGTERM(0),"^",9)
IF GMRGDN
WRITE !?5,"Additional Text: "
IF $SELECT($PIECE(GMRGTERM,"^",3)="":0,1:1)
DO PRAD^GMRGED4
+9 QUIT
SSC ;
+1 SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
+2 FOR GMRG1=GMRGSTAR:0
SET GMRG1=$ORDER(^TMP($JOB,"GMR",GMRG1))
SET GMRG0=$SELECT('$DATA(GMRGSTAR(0,GMRGSTAR(2)+1)):0,GMRG1>GMRGSTAR(0,GMRGSTAR(2)+1):1,1:0)
if GMRG1'>0
SET GMRGDN=1
if GMRG1'>0!GMRG0
SET GMRGSTAR(1)=GMRGCNT-1
if GMRG1'>0!GMRG0
QUIT
DO SSCR
if GMRGOUT!'GMRGLIN
QUIT
+3 IF $DATA(GMRGSTAR(0,GMRGSTAR(2)+1))
SET GMRG1=GMRGSTAR(3)
DO PARSEL^GMRGED4
+4 QUIT
SSCR ;
+1 SET GMRGSTAR=GMRG1-1
SET I=GMRG1
DO PRN^GMRGED8
if GMRGOUT!'GMRGLIN
QUIT
+2 QUIT
HDR ;
+1 FOR X=0:0
SET X=$ORDER(GMRGHPRT(X))
if X'>0
QUIT
IF $DATA(GMRGHPRT(X))#2
SET ^TMP($JOB,"GMRGHDR",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL)),X)=GMRGHPRT(X)
+2 IF GMRGSCRP
IF '$DATA(GMRGTPLT)
SET GMRGUSL(+GMRGRT_"T")=+GMRGRT
SET GMRGTPLT=GMRGSCRP
SET GMRGSCRP=0
DO EN1^GMRGED2
DO SETSEL^GMRGED4
SET GMRGSTAR=GMRGSTAR(0,GMRGSTAR(2))
+3 QUIT
ADSEL ; IF THE SELECTION HAS BEEN CHOSEN, BUT NOT CURRENTLY ACTIVE IN THE
+1 ; FOR THE PLAN, THEN IT WILL BE ADDED WITH ITS ADDED FLAG INDICATING NO
+2 KILL DA
SET DA(1)=GMRGPDA
SET X=$PIECE(GMRGPRC,"^")
SET DA=$ORDER(^GMR(124.3,DA(1),1,"B",X,0))
+3 IF DA'>0
DO ADNEW
+4 SET GMRGY=1
DO EN1^GMRGUTL
SET $PIECE(GMRGPRC(0),"^",2)=DA
SET $PIECE(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0),"^",2)=DA
+5 if '$PIECE(^GMR(124.3,DA(1),1,DA,0),"^",3)
QUIT
SET X=1
FOR GMRG1=0:0
SET GMRG1=$ORDER(^DD(124.31,4,1,GMRG1))
if GMRG1'>0
QUIT
if $DATA(^DD(124.31,4,1,GMRG1,2))
XECUTE ^(2)
+6 DO NOADS
+7 QUIT
NOADS ;
+1 SET X=0
SET $PIECE(^GMR(124.3,DA(1),1,DA,0),"^",3)=X
FOR GMRG1=0:0
SET GMRG1=$ORDER(^DD(124.31,4,1,GMRG1))
if GMRG1'>0
QUIT
if $DATA(^DD(124.31,4,1,GMRG1,1))
XECUTE ^(1)
+2 QUIT
ADNEW ;
+1 SET DA=$PIECE(^GMR(124.3,DA(1),1,0),"^",3)+1
FOR DA=DA:1
if '$DATA(^GMR(124.3,DA(1),1,DA,0))
QUIT
+2 SET ^GMR(124.3,DA(1),1,DA,0)=X
SET $PIECE(^GMR(124.3,DA(1),1,0),"^",3,4)=DA_"^"_($PIECE(^GMR(124.3,DA(1),1,0),"^",4)+1)
FOR GMRG1=0:0
SET GMRG1=$ORDER(^DD(124.31,.01,1,GMRG1))
if GMRG1'>0
QUIT
if $DATA(^DD(124.31,.01,1,GMRG1,1))
XECUTE ^(1)
+3 DO NOADS
+4 QUIT
FNDTMP ; FIND TEMPLATE THAT WILL BE USED IN PLAYBACK SESSION.
+1 IF $DATA(GMRGTPLT)
WRITE !!?5,$CHAR(7),"Templates CANNOT nested. You need to finish with the template you",!?5,"are currently using before you can select a new template.",!!,"Press return to continue "
READ X:DTIME
if '$TEST!(X="^")!(X="^^")
SET GMRGOUT=1
QUIT
+2 SET X=$PIECE(GMRGS,"[",2,99)
SET DIC="^GMRD(124.4,"
SET DIC(0)="EQMF"
SET DIC("S")="I $P(^(0),U,2)=+GMRGRT"
DO ^DIC
KILL DIC
if $DATA(DTOUT)!$DATA(DUOUT)
SET GMRGOUT=1
IF +Y'>0
+3 IF +Y'>0
if 'GMRGOUT
WRITE !!?5,$CHAR(7),"INVALID TEMPLATE SELECTION",!!,"Press return to continue "
READ X:DTIME
if '$TEST!(X="^")!(X="^^")
SET GMRGOUT=1
QUIT
+4 SET GMRGTPLT=+Y
SET GMRGUSL(+GMRGRT_"T")=+GMRGRT
+5 QUIT
