Routine: GMRGED9

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

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),"^")

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

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

GMRGED9.m