- 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 Feb 18, 2025@23:21:37 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
