GMRGED9 ;CISC/JH/RM-PATIENT DATA EDIT (cont.) ;4/5/90
;;3.0;Text Generator;;Jan 24, 1996
EN1 ; PRINT TEXT ON TOP
D:'$D(^TMP($J,"GMRGNAR","TOP")) EN2
S (X,GMRGLIN)=0,I=$O(^TMP($J,"GMRGNAR","TOP",0)),GMRLINS=$P(^(I,0),"^",2),L=1 W:GMRLINS>1 @IOF,^TMP($J,"GMRGNAR","TOP",I,1) F L=2:1:GMRLINS S J=$O(^TMP($J,"GMRGNAR","TOP",I,L)) Q:L="" D DISP Q:X="^"!GMRGOUT
K I,J,L,X,GMRLINS Q
DISP W !,^TMP($J,"GMRGNAR","TOP",I,L) S GMRGLIN=GMRGLIN+1 D INQ:GMRGLIN>(IOSL-5)!(L=GMRLINS) Q
;
INQ W !!,"Press return to continue, or ^ to stop narrative listing. " R X:DTIME S:X="^^"!'$T GMRGOUT=1 I 'GMRGOUT!(X="^") S GMRGLIN=0 W @IOF Q
;
EN2 ; SET TEXT ON TOP ARRAY, GMRGTOP(0)=TERM TO BEGIN BUILDING TEXT FROM
K ^TMP($J,"GMRGNAR") D NOW^%DTC S GMRGPDT=%,GMRGPAR=GMRGTOP(0),GMRGPAR(0)="1^0^0^"_"TOP" D EN1^GMRGPNBL
K %,GMRGPDT,GMRGPAR
Q
JSTCK ; MANIPULATE GMRGLVL STACK FOR JUMPING AND SCRIPING
S $P(GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),"^")=GMRG2,^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRG2)=GMRG0_"^^11",GMRG0(1)=0,GMRGSLVL=GMRG2
I GMRGUSL(GMRG0)'="" F GMRG0(0)=1:1:$L(GMRGUSL(GMRG0),"^") D PSTCK
S ^TMP($J,$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)=+GMRG0_"^^0",$P(GMRGLVL,"^")=$P(GMRGLVL,"^")-1,GMRGTLVL=$P(GMRGLVL(+GMRGLVL),"^")
Q
PSTCK ;
I 'GMRG0(1) S GMRG0(1)=1,$P(GMRGLVL,"^")=+GMRGLVL+1,GMRGLVL(+GMRGLVL)=1_"^"_GMRGTLVL,GMRGTLVL=1,GMRGLVL(+GMRGLVL,1)=1_"^"_GMRGSLVL,GMRGSLVL=1
E S GMRGTLVL=GMRGTLVL+1,$P(GMRGLVL($P(GMRGLVL,"^")),"^")=GMRGTLVL,$P(GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),"^")=1
S Y=+$P(GMRGUSL(GMRG0),"^",GMRG0(0)),GMRGKU=$O(^GMR(124.3,GMRGPDA,1,"B",Y,0))
S GMRGPRC=Y_"^"_$S(GMRG0["T":"S^11",GMRG0(0)<($L(GMRGUSL(GMRG0),"^")-1):"J^11",1:$S(GMRG0(0)=$L(GMRGUSL(GMRG0),"^"):"^",1:"J^1")_"0")
S GMRGPRC(0)=$S($D(^GMRD(124.2,Y,0)):$P(^(0),"^"),1:"")_"^"_GMRGKU_"^"_$S($D(^GMR(124.3,GMRGPDA,1,+GMRGKU,0)):$P(^(0),"^",2),1:"")
S ^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)=GMRGPRC,^(GMRGSLVL,0)=GMRGPRC(0)
Q:+GMRG0=+GMRGPRC I GMRGKU'>0 S GMRGSTAT="^^"
E S GMRGST=GMRGKU,GMRGST(1)=GMRGPDA D STAT^GMRGRUT0
I +GMRGRT=+GMRGTERM S GMRGSTAT="^^1"
I '$P(GMRGSTAT,"^",3) D ADSEL^GMRGEDB
Q
SCRPT ; PROCESS SCRIPT FOR A TERM
S GMRGTERM=$P(GMRGPRC,"^")_"^"_$P(GMRGPRC(0),"^",1,2),GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"") K GMRGUSL D SETSEL^GMRGED4
I '$D(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGPRC,"^"))),$P(GMRGPRC(0),"^")["]",$P(GMRGPRC,"^",2)'["/" S $P(GMRGPRC,"^",2)=$P(GMRGPRC,"^",2)_"/"
S GMRGKU=$O(^GMR(124.3,GMRGPDA,1,"B",+GMRGTERM,0)) I GMRGKU'>0 S GMRGSTAT="^^"
E S GMRGST=GMRGKU,GMRGST(1)=GMRGPDA D STAT^GMRGRUT0
I +GMRGRT=+GMRGTERM S GMRGSTAT="^^1"
I '$P(GMRGSTAT,"^",3) D ADSEL^GMRGEDB
F Z=0:0 S Z=$O(GMRGSEL(Z)) Q:Z'>0 I $D(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGSEL(Z))) S Y=$O(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGSEL(Z),0)),GMRGUSL(Z)="S"
S GMRGKU=$O(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGTERM,0)) Q:GMRGKU'>0 S GMRGTX=$S($D(^GMRD(124.4,GMRGTPLT,1,GMRGKU,0)):$P(^(0),"^",2),1:""),GMRGTX("OL")=$P(GMRGPRC(0),"^",3)
S Y=0 F Z=1:1:$L(GMRGTX("OL"),"|") I $P(GMRGTX("OL"),"|",Z)'="" S Y=1 Q
S:'Y GMRGTX("OL")=""
S Y=0 F Z=1:1:$L(GMRGTX,"|") I $P(GMRGTX,"|",Z)'="" S Y=1 Q
I 'Y S:$L(GMRGTX) $P(GMRGPRC,"^",2)=$P(GMRGPRC,"^",2)_$S($P(GMRGPRC,"^",2)'?.E1"/":"/",1:"") S GMRGTX=""
I GMRGTX("OL")="",GMRGTX'="" D SAT^GMRGED5
I $P(GMRGPRC,"^",2)?0.1AP1"/".E,GMRGTX="" D INTERNAL^GMRGED6 Q:GMRGOUT
S GMRGTX=$S($D(^GMRD(124.4,GMRGTPLT,1,GMRGKU,"ADD")):^("ADD"),1:""),GMRGTX("OL")=$S($D(^GMR(124.3,GMRGPDA,1,+$P(GMRGPRC(0),"^",2),"ADD")):^("ADD"),1:"")
I GMRGTX("OL")="",GMRGTX'="" S GMRGUSL("A")="",X=GMRGTX("OL"),DA=$P(GMRGPRC(0),"^",2),DA(1)=GMRGPDA,GMRGY=2,GMRGAT=1,GMRGZ="" D EN1^GMRGUTL S ^GMR(124.3,DA(1),1,DA,"ADD")=GMRGTX
X:$D(^GMRD(124.2,+GMRGTERM,7)) ^(7) Q:GMRGOUT D HDR^GMRGEDB Q:GMRGOUT
Q
GMRGED9 ;CISC/JH/RM-PATIENT DATA EDIT (cont.) ;4/5/90
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; PRINT TEXT ON TOP
+1 IF '$DATA(^TMP($JOB,"GMRGNAR","TOP"))
DO EN2
+2 SET (X,GMRGLIN)=0
SET I=$ORDER(^TMP($JOB,"GMRGNAR","TOP",0))
SET GMRLINS=$PIECE(^(I,0),"^",2)
SET L=1
IF GMRLINS>1
WRITE @IOF,^TMP($JOB,"GMRGNAR","TOP",I,1)
FOR L=2:1:GMRLINS
SET J=$ORDER(^TMP($JOB,"GMRGNAR","TOP",I,L))
IF L=""
QUIT
DO DISP
IF X="^"!GMRGOUT
QUIT
+3 KILL I,J,L,X,GMRLINS
QUIT
DISP WRITE !,^TMP($JOB,"GMRGNAR","TOP",I,L)
SET GMRGLIN=GMRGLIN+1
IF GMRGLIN>(IOSL-5)!(L=GMRLINS)
DO INQ
QUIT
+1 ;
INQ WRITE !!,"Press return to continue, or ^ to stop narrative listing. "
READ X:DTIME
IF X="^^"!'$TEST
SET GMRGOUT=1
IF 'GMRGOUT!(X="^")
SET GMRGLIN=0
WRITE @IOF
QUIT
+1 ;
EN2 ; SET TEXT ON TOP ARRAY, GMRGTOP(0)=TERM TO BEGIN BUILDING TEXT FROM
+1 KILL ^TMP($JOB,"GMRGNAR")
DO NOW^%DTC
SET GMRGPDT=%
SET GMRGPAR=GMRGTOP(0)
SET GMRGPAR(0)="1^0^0^"_"TOP"
DO EN1^GMRGPNBL
+2 KILL %,GMRGPDT,GMRGPAR
+3 QUIT
JSTCK ; MANIPULATE GMRGLVL STACK FOR JUMPING AND SCRIPING
+1 SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),"^")=GMRG2
SET ^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRG2)=GMRG0_"^^11"
SET GMRG0(1)=0
SET GMRGSLVL=GMRG2
+2 IF GMRGUSL(GMRG0)'=""
FOR GMRG0(0)=1:1:$LENGTH(GMRGUSL(GMRG0),"^")
DO PSTCK
+3 SET ^TMP($JOB,$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)=+GMRG0_"^^0"
SET $PIECE(GMRGLVL,"^")=$PIECE(GMRGLVL,"^")-1
SET GMRGTLVL=$PIECE(GMRGLVL(+GMRGLVL),"^")
+4 QUIT
PSTCK ;
+1 IF 'GMRG0(1)
SET GMRG0(1)=1
SET $PIECE(GMRGLVL,"^")=+GMRGLVL+1
SET GMRGLVL(+GMRGLVL)=1_"^"_GMRGTLVL
SET GMRGTLVL=1
SET GMRGLVL(+GMRGLVL,1)=1_"^"_GMRGSLVL
SET GMRGSLVL=1
+2 IF '$TEST
SET GMRGTLVL=GMRGTLVL+1
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")=GMRGTLVL
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),"^")=1
+3 SET Y=+$PIECE(GMRGUSL(GMRG0),"^",GMRG0(0))
SET GMRGKU=$ORDER(^GMR(124.3,GMRGPDA,1,"B",Y,0))
+4 SET GMRGPRC=Y_"^"_$SELECT(GMRG0["T":"S^11",GMRG0(0)<($LENGTH(GMRGUSL(GMRG0),"^")-1):"J^11",1:$SELECT(GMRG0(0)=$LENGTH(GMRGUSL(GMRG0),"^"):"^",1:"J^1")_"0")
+5 SET GMRGPRC(0)=$SELECT($DATA(^GMRD(124.2,Y,0)):$PIECE(^(0),"^"),1:"")_"^"_GMRGKU_"^"_$SELECT($DATA(^GMR(124.3,GMRGPDA,1,+GMRGKU,0)):$PIECE(^(0),"^",2),1:"")
+6 SET ^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)=GMRGPRC
SET ^(GMRGSLVL,0)=GMRGPRC(0)
+7 IF +GMRG0=+GMRGPRC
QUIT
IF GMRGKU'>0
SET GMRGSTAT="^^"
+8 IF '$TEST
SET GMRGST=GMRGKU
SET GMRGST(1)=GMRGPDA
DO STAT^GMRGRUT0
+9 IF +GMRGRT=+GMRGTERM
SET GMRGSTAT="^^1"
+10 IF '$PIECE(GMRGSTAT,"^",3)
DO ADSEL^GMRGEDB
+11 QUIT
SCRPT ; PROCESS SCRIPT FOR A TERM
+1 SET GMRGTERM=$PIECE(GMRGPRC,"^")_"^"_$PIECE(GMRGPRC(0),"^",1,2)
SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
KILL GMRGUSL
DO SETSEL^GMRGED4
+2 IF '$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",$PIECE(GMRGPRC,"^")))
IF $PIECE(GMRGPRC(0),"^")["]"
IF $PIECE(GMRGPRC,"^",2)'["/"
SET $PIECE(GMRGPRC,"^",2)=$PIECE(GMRGPRC,"^",2)_"/"
+3 SET GMRGKU=$ORDER(^GMR(124.3,GMRGPDA,1,"B",+GMRGTERM,0))
IF GMRGKU'>0
SET GMRGSTAT="^^"
+4 IF '$TEST
SET GMRGST=GMRGKU
SET GMRGST(1)=GMRGPDA
DO STAT^GMRGRUT0
+5 IF +GMRGRT=+GMRGTERM
SET GMRGSTAT="^^1"
+6 IF '$PIECE(GMRGSTAT,"^",3)
DO ADSEL^GMRGEDB
+7 FOR Z=0:0
SET Z=$ORDER(GMRGSEL(Z))
IF Z'>0
QUIT
IF $DATA(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGSEL(Z)))
SET Y=$ORDER(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGSEL(Z),0))
SET GMRGUSL(Z)="S"
+8 SET GMRGKU=$ORDER(^GMRD(124.4,GMRGTPLT,1,"B",+GMRGTERM,0))
IF GMRGKU'>0
QUIT
SET GMRGTX=$SELECT($DATA(^GMRD(124.4,GMRGTPLT,1,GMRGKU,0)):$PIECE(^(0),"^",2),1:"")
SET GMRGTX("OL")=$PIECE(GMRGPRC(0),"^",3)
+9 SET Y=0
FOR Z=1:1:$LENGTH(GMRGTX("OL"),"|")
IF $PIECE(GMRGTX("OL"),"|",Z)'=""
SET Y=1
QUIT
+10 IF 'Y
SET GMRGTX("OL")=""
+11 SET Y=0
FOR Z=1:1:$LENGTH(GMRGTX,"|")
IF $PIECE(GMRGTX,"|",Z)'=""
SET Y=1
QUIT
+12 IF 'Y
IF $LENGTH(GMRGTX)
SET $PIECE(GMRGPRC,"^",2)=$PIECE(GMRGPRC,"^",2)_$SELECT($PIECE(GMRGPRC,"^",2)'?.E1"/":"/",1:"")
SET GMRGTX=""
+13 IF GMRGTX("OL")=""
IF GMRGTX'=""
DO SAT^GMRGED5
+14 IF $PIECE(GMRGPRC,"^",2)?0.1AP1"/".E
IF GMRGTX=""
DO INTERNAL^GMRGED6
IF GMRGOUT
QUIT
+15 SET GMRGTX=$SELECT($DATA(^GMRD(124.4,GMRGTPLT,1,GMRGKU,"ADD")):^("ADD"),1:"")
SET GMRGTX("OL")=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,+$PIECE(GMRGPRC(0),"^",2),"ADD")):^("ADD"),1:"")
+16 IF GMRGTX("OL")=""
IF GMRGTX'=""
SET GMRGUSL("A")=""
SET X=GMRGTX("OL")
SET DA=$PIECE(GMRGPRC(0),"^",2)
SET DA(1)=GMRGPDA
SET GMRGY=2
SET GMRGAT=1
SET GMRGZ=""
DO EN1^GMRGUTL
SET ^GMR(124.3,DA(1),1,DA,"ADD")=GMRGTX
+17 IF $DATA(^GMRD(124.2,+GMRGTERM,7))
XECUTE ^(7)
IF GMRGOUT
QUIT
DO HDR^GMRGEDB
IF GMRGOUT
QUIT
+18 QUIT
