51 lines
3.6 KiB
Mathematica
51 lines
3.6 KiB
Mathematica
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
|