47 lines
4.6 KiB
Mathematica
47 lines
4.6 KiB
Mathematica
GMRGED2 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;1/23/96
|
|
;;3.0;Text Generator;;Jan 24, 1996
|
|
EN1 ; ENTRY TO PROCESS USER SELECTIONS IN GMRGUSL ARRAY
|
|
S GMRG0="",GMRGTLVL=$P(GMRGLVL($P(GMRGLVL,"^")),"^")+1,$P(GMRGLVL($P(GMRGLVL,"^")),"^")=GMRGTLVL K ^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL),GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),^TMP($J,"GMRGHDR",$P(GMRGLVL,"^"),GMRGTLVL)
|
|
F GMRG2=1:1 S GMRG0=$O(GMRGUSL(GMRG0)) Q:GMRG0="" D STUT^GMRGED6
|
|
JS F GMRGSLVL=0:0 S GMRGSLVL=$O(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)) Q:GMRGSLVL'>0 S $P(GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),"^")=GMRGSLVL D PRCSEL Q:GMRGOUT
|
|
K ^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL),^TMP($J,"GMRGHDR",$P(GMRGLVL,"^"),GMRGTLVL)
|
|
I GMRGTLVL>1 K GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL) S GMRGTLVL=$P(GMRGLVL($P(GMRGLVL,"^")),"^")-1,$P(GMRGLVL($P(GMRGLVL,"^")),"^")=GMRGTLVL,GMRGSLVL=$P(GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),"^")
|
|
E S GMRGSLVL=+$P(GMRGLVL($P(GMRGLVL,"^"),GMRGTLVL),"^",2),GMRGTLVL=$P(GMRGLVL($P(GMRGLVL,"^")),"^",2) K GMRGLVL(+$P(GMRGLVL,"^")) S $P(GMRGLVL,"^")=$P(GMRGLVL,"^")-1
|
|
S GMRGPRC=$S($D(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)):^(GMRGSLVL),1:""),GMRGPRC(0)=$S($D(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)):^(0),1:"")
|
|
S:GMRGTOP(0)=+GMRGTERM GMRGTOP(0)=+GMRGRT S GMRGTERM=$P(GMRGPRC,"^")_"^"_$P(GMRGPRC(0),"^",1,2),GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:""),GMRGNORD=$P(GMRGPRC,"^",3)
|
|
Q
|
|
PRCSEL ;
|
|
S GMRGPRC=$S($D(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)):^(GMRGSLVL),1:"") Q:GMRGPRC="" S GMRGNORD=$P(GMRGPRC,"^",3)
|
|
I $P(GMRGPRC,"^")["*"!($P(GMRGPRC,"^")["T") S $P(GMRGLVL,"^")=$P(GMRGLVL,"^")+1,GMRGTLVL=1 D JS Q:$P(GMRGPRC,"^")'["T" K GMRGTPLT S GMRGSCRP=0 Q
|
|
S GMRG2=$S($D(^GMRD(124.2,+GMRGPRC,0)):^(0),1:"") I $P(GMRGPRC,"^",2)'="@",GMRGTOP=+GMRGRT S:$S($D(^GMRD(124.25,+$P(GMRG2,"^",4),0)):$P(^(0),"^",3),1:0) GMRGTOP(0)=+GMRGPRC
|
|
S GMRGMIN=0
|
|
I $P(GMRGPRC,"^")="A" D ADDITION^GMRGED5 Q
|
|
S GMRGPRC(0)=$S($D(^TMP($J,"GMRGLVL",$P(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)):^(0),1:"")
|
|
I $P(GMRGPRC,"^",2)="J" S GMRGTLVL=GMRGTLVL+1,$P(GMRGLVL($P(GMRGLVL,"^")),"^")=GMRGTLVL,GMRGTERM=$P(GMRGPRC,"^")_"^"_$P(GMRGPRC(0),"^",1,2),GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
|
|
I X:$D(^GMRD(124.2,+GMRGTERM,7)) ^(7) Q:GMRGOUT D HDR^GMRGEDB,JS,SETSEL^GMRGED4 Q:$P(GMRGPRC,"^",3)=11 G QP:GMRGOUT
|
|
I $P(GMRGPRC,"^",2)="S" D SCRPT^GMRGED9 Q:GMRGOUT D EN1,SETSEL^GMRGED4 G QP:GMRGOUT
|
|
I $P(GMRGPRC,"^",2)="@" S GMRGKU=GMRGTERM,GMRGKU(0)=GMRGTERM(0),GMRGTERM=$P(GMRGPRC,"^")_"^"_$P(GMRGPRC(0),"^",1,2),GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"") D DELETE^GMRGED6 S GMRGTERM=GMRGKU,GMRGTERM(0)=GMRGKU(0) Q
|
|
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",$P(GMRGPRC,"^"),0)) I GMRGKU'>0 S GMRGSTAT="^^"
|
|
E S GMRGST=GMRGKU,GMRGST(1)=GMRGPDA D STAT^GMRGRUT0
|
|
I +GMRGPRC=+GMRGRT S GMRGSTAT="^^1"
|
|
I '$P(GMRGPRC(0),"^",2),GMRGKU S $P(GMRGPRC(0),"^",2,3)=GMRGKU_"^"_$P($G(^GMR(124.3,GMRGPDA,1,GMRGKU,0)),"^",2)
|
|
I '$P(GMRGSTAT,"^",3) D ADSEL^GMRGEDB
|
|
I $P(GMRGPRC,"^",2)?0.1";".E1"/".E D INTERNAL^GMRGED6 G QP:GMRGOUT
|
|
I $P(GMRGPRC,"^",2)?1";".E D APPEND^GMRGED5 G QP:GMRGOUT
|
|
REPRC S GMRGKU=GMRGTERM,GMRGKU(0)=GMRGTERM(0),GMRGTERM=$P(GMRGPRC,"^")_"^"_$P(GMRGPRC(0),"^",1,2),GMRGTERM(0)=$S($D(^GMRD(124.2,+GMRGTERM,0)):^(0),1:""),GMRGTCHK=$S($P(GMRGTERM(0),"^",2):$P(GMRGTERM(0),"^",2),1:3)
|
|
I GMRGTCHK=3 X:$D(^GMRD(124.2,$P(GMRGTERM,"^"),7)) ^(7) D:'GMRGOUT HDR^GMRGEDB,PRCTRM^GMRGED6 X:$D(^GMRD(124.2,$P(GMRGTERM,"^"),9))&'GMRGOUT ^(9) S GMRGTERM=GMRGKU,GMRGTERM(0)=GMRGKU(0) Q
|
|
I $P(GMRGPRC,"^",2)'="S"!($P(GMRGPRC,"^",2)="S"&'($P(GMRGPRC,"^",3)#2)) D EN1^GMRGED1
|
|
QP S GMRG2=$S(+$P(GMRGTERM,"^",3)'>0:0,'$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),"ADD")):0,^("ADD")'="":1,1:0)
|
|
F GMRG1=0:0 S GMRG1=$O(GMRGSEL(GMRG1)) Q:GMRG1'>0 I $P(GMRGSEL(GMRG1),"^",3) S GMRG2=GMRG2+1
|
|
S GMRGMIN=$S(GMRG2<$P(GMRGTERM(0),"^",6):1,1:0)
|
|
I 'GMRGMIN D PRCTRM^GMRGED6
|
|
I GMRGMIN D
|
|
. D NOTMIN^GMRGED7 Q:GMRGOUT!($P(GMRGTERM(0),"^",12)#2)
|
|
. W !!?3,$C(7),"THE MINIMUM NUMBER OF SELECTIONS HAVE NOT BEEN SELECTED FOR THIS FRAME",!?3,"THEREFORE IT WILL NOT BE FILED WITH THE PATIENT DATA."
|
|
. F R !,"Press return to continue, ^ to exit ",X:DTIME S:'$T X="^^" S:X="^"!(X="^^") GMRGOUT=1 Q:"^^"[X W !?3,$C(7),"<RET> WILL CONTINUE WITH DATA ENTRY, ^ OR ^^ WILL EXIT FROM THE APPLICATION."
|
|
. Q
|
|
S GMRGRDIS=0 X:$D(^GMRD(124.2,$P(GMRGTERM,"^"),9))&(GMRGUP!GMRGOUT) ^(9)
|
|
I GMRGRDIS S $P(GMRGPRC,"^",3)=+($P(GMRGPRC,"^",3)\10_0),$P(^TMP($J,"GMRGLVL",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)=$P(GMRGPRC,"^",3) G:GMRGRDIS REPRC
|
|
Q
|