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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED2 4764 printed Oct 16, 2024@17:55:57 Page 2
GMRGED2 ;HIRMFO/RM-PATIENT DATA EDIT (cont.) ;1/23/96
+1 ;;3.0;Text Generator;;Jan 24, 1996
EN1 ; ENTRY TO PROCESS USER SELECTIONS IN GMRGUSL ARRAY
+1 SET GMRG0=""
SET GMRGTLVL=$PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")+1
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")=GMRGTLVL
KILL ^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL),GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),^TMP($JOB,"GMRGHDR",$PIECE(GMRGLVL,"^"),GMRGTLVL)
+2 FOR GMRG2=1:1
SET GMRG0=$ORDER(GMRGUSL(GMRG0))
if GMRG0=""
QUIT
DO STUT^GMRGED6
JS FOR GMRGSLVL=0:0
SET GMRGSLVL=$ORDER(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL))
if GMRGSLVL'>0
QUIT
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),"^")=GMRGSLVL
DO PRCSEL
if GMRGOUT
QUIT
+1 KILL ^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL),^TMP($JOB,"GMRGHDR",$PIECE(GMRGLVL,"^"),GMRGTLVL)
+2 IF GMRGTLVL>1
KILL GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL)
SET GMRGTLVL=$PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")-1
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")=GMRGTLVL
SET GMRGSLVL=$PIECE(GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),"^")
+3 IF '$TEST
SET GMRGSLVL=+$PIECE(GMRGLVL($PIECE(GMRGLVL,"^"),GMRGTLVL),"^",2)
SET GMRGTLVL=$PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^",2)
KILL GMRGLVL(+$PIECE(GMRGLVL,"^"))
SET $PIECE(GMRGLVL,"^")=$PIECE(GMRGLVL,"^")-1
+4 SET GMRGPRC=$SELECT($DATA(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)):^(GMRGSLVL),1:"")
SET GMRGPRC(0)=$SELECT($DATA(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)):^(0),1:"")
+5 if GMRGTOP(0)=+GMRGTERM
SET GMRGTOP(0)=+GMRGRT
SET GMRGTERM=$PIECE(GMRGPRC,"^")_"^"_$PIECE(GMRGPRC(0),"^",1,2)
SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
SET GMRGNORD=$PIECE(GMRGPRC,"^",3)
+6 QUIT
PRCSEL ;
+1 SET GMRGPRC=$SELECT($DATA(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL)):^(GMRGSLVL),1:"")
if GMRGPRC=""
QUIT
SET GMRGNORD=$PIECE(GMRGPRC,"^",3)
+2 IF $PIECE(GMRGPRC,"^")["*"!($PIECE(GMRGPRC,"^")["T")
SET $PIECE(GMRGLVL,"^")=$PIECE(GMRGLVL,"^")+1
SET GMRGTLVL=1
DO JS
if $PIECE(GMRGPRC,"^")'["T"
QUIT
KILL GMRGTPLT
SET GMRGSCRP=0
QUIT
+3 SET GMRG2=$SELECT($DATA(^GMRD(124.2,+GMRGPRC,0)):^(0),1:"")
IF $PIECE(GMRGPRC,"^",2)'="@"
IF GMRGTOP=+GMRGRT
if $SELECT($DATA(^GMRD(124.25,+$PIECE(GMRG2,"^",4),0))
SET GMRGTOP(0)=+GMRGPRC
+4 SET GMRGMIN=0
+5 IF $PIECE(GMRGPRC,"^")="A"
DO ADDITION^GMRGED5
QUIT
+6 SET GMRGPRC(0)=$SELECT($DATA(^TMP($JOB,"GMRGLVL",$PIECE(GMRGLVL,"^"),GMRGTLVL,GMRGSLVL,0)):^(0),1:"")
+7 IF $PIECE(GMRGPRC,"^",2)="J"
SET GMRGTLVL=GMRGTLVL+1
SET $PIECE(GMRGLVL($PIECE(GMRGLVL,"^")),"^")=GMRGTLVL
SET GMRGTERM=$PIECE(GMRGPRC,"^")_"^"_$PIECE(GMRGPRC(0),"^",1,2)
SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
+8 IF $TEST
if $DATA(^GMRD(124.2,+GMRGTERM,7))
XECUTE ^(7)
if GMRGOUT
QUIT
DO HDR^GMRGEDB
DO JS
DO SETSEL^GMRGED4
if $PIECE(GMRGPRC,"^",3)=11
QUIT
if GMRGOUT
GOTO QP
+9 IF $PIECE(GMRGPRC,"^",2)="S"
DO SCRPT^GMRGED9
if GMRGOUT
QUIT
DO EN1
DO SETSEL^GMRGED4
if GMRGOUT
GOTO QP
+10 IF $PIECE(GMRGPRC,"^",2)="@"
SET GMRGKU=GMRGTERM
SET GMRGKU(0)=GMRGTERM(0)
SET GMRGTERM=$PIECE(GMRGPRC,"^")_"^"_$PIECE(GMRGPRC(0),"^",1,2)
SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
DO DELETE^GMRGED6
SET GMRGTERM=GMRGKU
SET GMRGTERM(0)=GMRGKU(0)
QUIT
+11 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)_"/"
+12 SET GMRGKU=$ORDER(^GMR(124.3,GMRGPDA,1,"B",$PIECE(GMRGPRC,"^"),0))
IF GMRGKU'>0
SET GMRGSTAT="^^"
+13 IF '$TEST
SET GMRGST=GMRGKU
SET GMRGST(1)=GMRGPDA
DO STAT^GMRGRUT0
+14 IF +GMRGPRC=+GMRGRT
SET GMRGSTAT="^^1"
+15 IF '$PIECE(GMRGPRC(0),"^",2)
IF GMRGKU
SET $PIECE(GMRGPRC(0),"^",2,3)=GMRGKU_"^"_$PIECE($GET(^GMR(124.3,GMRGPDA,1,GMRGKU,0)),"^",2)
+16 IF '$PIECE(GMRGSTAT,"^",3)
DO ADSEL^GMRGEDB
+17 IF $PIECE(GMRGPRC,"^",2)?0.1";".E1"/".E
DO INTERNAL^GMRGED6
if GMRGOUT
GOTO QP
+18 IF $PIECE(GMRGPRC,"^",2)?1";".E
DO APPEND^GMRGED5
if GMRGOUT
GOTO QP
REPRC SET GMRGKU=GMRGTERM
SET GMRGKU(0)=GMRGTERM(0)
SET GMRGTERM=$PIECE(GMRGPRC,"^")_"^"_$PIECE(GMRGPRC(0),"^",1,2)
SET GMRGTERM(0)=$SELECT($DATA(^GMRD(124.2,+GMRGTERM,0)):^(0),1:"")
SET GMRGTCHK=$SELECT($PIECE(GMRGTERM(0),"^",2):$PIECE(GMRGTERM(0),"^",2),1:3)
+1 IF GMRGTCHK=3
if $DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),7))
XECUTE ^(7)
if 'GMRGOUT
DO HDR^GMRGEDB
DO PRCTRM^GMRGED6
if $DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),9))&'GMRGOUT
XECUTE ^(9)
SET GMRGTERM=GMRGKU
SET GMRGTERM(0)=GMRGKU(0)
QUIT
+2 IF $PIECE(GMRGPRC,"^",2)'="S"!($PIECE(GMRGPRC,"^",2)="S"&'($PIECE(GMRGPRC,"^",3)#2))
DO EN1^GMRGED1
QP SET GMRG2=$SELECT(+$PIECE(GMRGTERM,"^",3)'>0:0,'$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGTERM,"^",3),"ADD")):0,^("ADD")'="":1,1:0)
+1 FOR GMRG1=0:0
SET GMRG1=$ORDER(GMRGSEL(GMRG1))
if GMRG1'>0
QUIT
IF $PIECE(GMRGSEL(GMRG1),"^",3)
SET GMRG2=GMRG2+1
+2 SET GMRGMIN=$SELECT(GMRG2<$PIECE(GMRGTERM(0),"^",6):1,1:0)
+3 IF 'GMRGMIN
DO PRCTRM^GMRGED6
+4 IF GMRGMIN
Begin DoDot:1
+5 DO NOTMIN^GMRGED7
if GMRGOUT!($PIECE(GMRGTERM(0),"^",12)#2)
QUIT
+6 WRITE !!?3,$CHAR(7),"THE MINIMUM NUMBER OF SELECTIONS HAVE NOT BEEN SELECTED FOR THIS FRAME",!?3,"THEREFORE IT WILL NOT BE FILED WITH THE PATIENT DATA."
+7 FOR
READ !,"Press return to continue, ^ to exit ",X:DTIME
if '$TEST
SET X="^^"
if X="^"!(X="^^")
SET GMRGOUT=1
if "^^"[X
QUIT
WRITE !?3,$CHAR(7),"<RET> WILL CONTINUE WITH DATA ENTRY, ^ OR ^^ WILL EXIT FROM THE APPLICATION."
+8 QUIT
End DoDot:1
+9 SET GMRGRDIS=0
if $DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),9))&(GMRGUP!GMRGOUT)
XECUTE ^(9)
+10 IF GMRGRDIS
SET $PIECE(GMRGPRC,"^",3)=+($PIECE(GMRGPRC,"^",3)\10_0)
SET $PIECE(^TMP($JOB,"GMRGLVL",+GMRGLVL,+GMRGLVL(+GMRGLVL),+GMRGLVL(+GMRGLVL,+GMRGLVL(+GMRGLVL))),"^",3)=$PIECE(GMRGPRC,"^",3)
if GMRGRDIS
GOTO REPRC
+11 QUIT
