GMRGED4 ;CISC/RM-PATIENT DATA EDIT (cont.) ;3/16/89
;;3.0;Text Generator;;Jan 24, 1996
PRTDEF ; PRINT TERM DEFINITION OF ALL TERMS ON THIS SCREEN
W ! S GMRG02=0 F GMRG00=GMRGSTAR(0,GMRGSTAR(2)):0 S GMRG00=$O(GMRGSEL(GMRG00)) Q:GMRG00'>0!(GMRG00>GMRGSTAR(1)) S GMRG01=$P(GMRGSEL(GMRG00),"^") D PRTD1 Q:GMRGOUT
I GMRGOUT S:GMRGOUT=1 GMRGOUT=0 Q
W !,"Press return to continue " R X:DTIME I X="^"!(X="^^")!'$T S GMRGOUT=1
Q
PRTD1 ;
I GMRG02>(IOSL-3) S GMRG02=0 W !,"Press return to continue " R X:DTIME S:X="^^"!(X="^")!'$T GMRGOUT=$S(X="^":1,1:2) Q:GMRGOUT
W !,"'" S GMRGXPRT=$P(GMRGSEL(GMRG00),"^",2),GMRGXPRT(0)=$S($D(GMRGSEL(GMRG00,1)):$P(GMRGSEL(GMRG00,1),"^",2),1:"") D EN1^GMRGRUT2 W "'" S GMRG02=GMRG02+2
K ^UTILITY($J,"W") F GMRG03=0:0 S GMRG03=$O(^GMRD(124.2,GMRG01,"TD",GMRG03)) Q:GMRG03'>0 S X=$S($D(^(GMRG03,0)):^(0),1:""),DIWL=5,DIWR=IOM,DIWF="W",GMRG02=GMRG02+1 D ^DIWP
D ^DIWW S GMRG02=GMRG02+1 K DIWL,DIWR,DIWF,^UTILITY($J,"W")
Q
PRAD ; PRINT ADDITIONAL TEXT
S GMRGPLN=$S(+$P(GMRGTERM,"^",3)'>0:"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),"ADD")):^("ADD"),1:""),GMRGL=IOM-22,GMRGLEN=GMRGL,GMRGLIN=GMRGLIN+1 D FITLINE^GMRGRUT1 W GMRGPLN(0)
F GMRG1=0:0 Q:GMRGPLN(1)="" S GMRGLEN=GMRGL,GMRGPLN=GMRGPLN(1) D FITLINE^GMRGRUT1 W !?22,GMRGPLN(0) S GMRGLIN=GMRGLIN+1 I GMRGLIN>(IOSL-4) S GMRGLIN=0 W !,"'^' TO STOP: " R X:DTIME S GMRGOUT=$S(X="^":1,X="^^"!'$T:2,1:GMRGOUT) Q:GMRGOUT
Q
SETSEL ; SET GMRGSEL ARRAY
F GMRG1=0:0 S GMRG1=$O(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^"),GMRG1)) Q:GMRG1'>0 S GMRGPAT(GMRG1)=^(GMRG1)
K GMRGSEL S GMRGUP=0,GMRGCNT=1,GMRG2="" F GMRG2(0)=0:0 S GMRG2=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",GMRG2)) Q:GMRG2="" F GMRG1=0:0 S GMRG1=$O(^GMRD(124.2,$P(GMRGTERM,"^"),1,"AC",GMRG2,GMRG1)) Q:GMRG1'>0 D PRTSEL
I $P(GMRGTERM(0),"^",10) D EN1^GMRGED8 ; save for split screen
I $P(GMRGTERM(0),"^",11) D EN2^GMRGED9
Q
PRTSEL ; SET UP THE GMRGSEL ARRAY OF SELECTIONS OF THIS TERM.
S GMRGSEL=$S($D(^GMRD(124.2,$P(GMRGTERM,"^"),1,GMRG1,0)):$P(^(0),"^",1,2),1:""),GMRGND=$P(GMRGSEL,"^") Q:GMRGND="" D PATDAT^GMRGRUT2 S GMRGSEL(GMRGCNT)=GMRGSEL_"^"_GMRGPRT S:GMRGPRT GMRGSEL(GMRGCNT,1)=GMRGPRT(0) S GMRGCNT=GMRGCNT+1
Q
REPRT ;
S GMRGPRT=$P(GMRGSEL(GMRG1),"^",3),GMRGSEL=GMRGSEL(GMRG1),GMRGPRT(0)=$S($D(GMRGSEL(GMRG1,1)):GMRGSEL(GMRG1,1),1:""),GMRGSTAR=GMRG1-1 Q:GMRGOUT I GMRGLIN>(IOSL-4) S GMRGLIN=0 D PARSEL Q
S GMRGLIN=GMRGLIN+1 W !,$S(GMRGPRT:"**",1:""),?4,$S('$D(^GMRD(124.2,"ATY",3,$P(GMRGSEL,"^"))):"+",1:" "),$J((GMRG1),2),". "
S GMRGXPRT=$P(GMRGSEL,"^",2),GMRGXPRT(0)=$P(GMRGPRT(0),"^",2),GMRGXPRT(1)="9^"_IOM_"^1^"_$S(GMRGPRT&GMRGIO("S")&'$P(GMRGSITE(0),"^",2):1,1:0)_"^" D EN1^GMRGRUT2
S GMRGTLC=$Y
K GMRGHPRT I $D(^GMRD(124.2,$P(GMRGSEL,"^"),10)) X ^(10)
F X=0:0 S X=$O(GMRGHPRT(X)) Q:X'>0 W ?(+GMRGHPRT(X)),$P(GMRGHPRT(X),"^",2)
S GMRGTLC=$Y-GMRGTLC I GMRGTLC>0 S GMRGLIN=GMRGLIN+GMRGTLC
Q
PARSEL ;
W !!,"Please make the appropriate selections from this screen before continuing onto",!,"the next screen. " D PROMPT^GMRGED3 R GMRGS:DTIME
S:GMRGS="^"!(GMRGS="^^")!'$T GMRGOUT=1 Q:GMRGOUT S GMRGSTAR(1)=GMRG1,GMRGPSEL=1 D PSEL^GMRGED1 I 'GMRGOOD G:GMRGMSR PARSEL Q
S GMRGSTAR(2)=GMRGSTAR(2)+1,GMRGSTAR=GMRGSTAR(1)-1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED4 3240 printed Oct 16, 2024@17:55:59 Page 2
GMRGED4 ;CISC/RM-PATIENT DATA EDIT (cont.) ;3/16/89
+1 ;;3.0;Text Generator;;Jan 24, 1996
PRTDEF ; PRINT TERM DEFINITION OF ALL TERMS ON THIS SCREEN
+1 WRITE !
SET GMRG02=0
FOR GMRG00=GMRGSTAR(0,GMRGSTAR(2)):0
SET GMRG00=$ORDER(GMRGSEL(GMRG00))
if GMRG00'>0!(GMRG00>GMRGSTAR(1))
QUIT
SET GMRG01=$PIECE(GMRGSEL(GMRG00),"^")
DO PRTD1
if GMRGOUT
QUIT
+2 IF GMRGOUT
if GMRGOUT=1
SET GMRGOUT=0
QUIT
+3 WRITE !,"Press return to continue "
READ X:DTIME
IF X="^"!(X="^^")!'$TEST
SET GMRGOUT=1
+4 QUIT
PRTD1 ;
+1 IF GMRG02>(IOSL-3)
SET GMRG02=0
WRITE !,"Press return to continue "
READ X:DTIME
if X="^^"!(X="^")!'$TEST
SET GMRGOUT=$SELECT(X="^":1,1:2)
if GMRGOUT
QUIT
+2 WRITE !,"'"
SET GMRGXPRT=$PIECE(GMRGSEL(GMRG00),"^",2)
SET GMRGXPRT(0)=$SELECT($DATA(GMRGSEL(GMRG00,1)):$PIECE(GMRGSEL(GMRG00,1),"^",2),1:"")
DO EN1^GMRGRUT2
WRITE "'"
SET GMRG02=GMRG02+2
+3 KILL ^UTILITY($JOB,"W")
FOR GMRG03=0:0
SET GMRG03=$ORDER(^GMRD(124.2,GMRG01,"TD",GMRG03))
if GMRG03'>0
QUIT
SET X=$SELECT($DATA(^(GMRG03,0)):^(0),1:"")
SET DIWL=5
SET DIWR=IOM
SET DIWF="W"
SET GMRG02=GMRG02+1
DO ^DIWP
+4 DO ^DIWW
SET GMRG02=GMRG02+1
KILL DIWL,DIWR,DIWF,^UTILITY($JOB,"W")
+5 QUIT
PRAD ; PRINT ADDITIONAL TEXT
+1 SET GMRGPLN=$SELECT(+$PIECE(GMRGTERM,"^",3)'>0:"",$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGTERM,"^",3),"ADD")):^("ADD"),1:"")
SET GMRGL=IOM-22
SET GMRGLEN=GMRGL
SET GMRGLIN=GMRGLIN+1
DO FITLINE^GMRGRUT1
WRITE GMRGPLN(0)
+2 FOR GMRG1=0:0
if GMRGPLN(1)=""
QUIT
SET GMRGLEN=GMRGL
SET GMRGPLN=GMRGPLN(1)
DO FITLINE^GMRGRUT1
WRITE !?22,GMRGPLN(0)
SET GMRGLIN=GMRGLIN+1
IF GMRGLIN>(IOSL-4)
SET GMRGLIN=0
WRITE !,"'^' TO STOP: "
READ X:DTIME
SET GMRGOUT=$SELECT(X="^":1,X="^^"!'$TEST:2,1:GMRGOUT)
if GMRGOUT
QUIT
+3 QUIT
SETSEL ; SET GMRGSEL ARRAY
+1 FOR GMRG1=0:0
SET GMRG1=$ORDER(^GMR(124.3,GMRGPDA,1,"ALIST",$PIECE(GMRGTERM,"^"),GMRG1))
if GMRG1'>0
QUIT
SET GMRGPAT(GMRG1)=^(GMRG1)
+2 KILL GMRGSEL
SET GMRGUP=0
SET GMRGCNT=1
SET GMRG2=""
FOR GMRG2(0)=0:0
SET GMRG2=$ORDER(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,"AC",GMRG2))
if GMRG2=""
QUIT
FOR GMRG1=0:0
SET GMRG1=$ORDER(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,"AC",GMRG2,GMRG1))
if GMRG1'>0
QUIT
DO PRTSEL
+3 ; save for split screen
IF $PIECE(GMRGTERM(0),"^",10)
DO EN1^GMRGED8
+4 IF $PIECE(GMRGTERM(0),"^",11)
DO EN2^GMRGED9
+5 QUIT
PRTSEL ; SET UP THE GMRGSEL ARRAY OF SELECTIONS OF THIS TERM.
+1 SET GMRGSEL=$SELECT($DATA(^GMRD(124.2,$PIECE(GMRGTERM,"^"),1,GMRG1,0)):$PIECE(^(0),"^",1,2),1:"")
SET GMRGND=$PIECE(GMRGSEL,"^")
if GMRGND=""
QUIT
DO PATDAT^GMRGRUT2
SET GMRGSEL(GMRGCNT)=GMRGSEL_"^"_GMRGPRT
if GMRGPRT
SET GMRGSEL(GMRGCNT,1)=GMRGPRT(0)
SET GMRGCNT=GMRGCNT+1
+2 QUIT
REPRT ;
+1 SET GMRGPRT=$PIECE(GMRGSEL(GMRG1),"^",3)
SET GMRGSEL=GMRGSEL(GMRG1)
SET GMRGPRT(0)=$SELECT($DATA(GMRGSEL(GMRG1,1)):GMRGSEL(GMRG1,1),1:"")
SET GMRGSTAR=GMRG1-1
if GMRGOUT
QUIT
IF GMRGLIN>(IOSL-4)
SET GMRGLIN=0
DO PARSEL
QUIT
+2 SET GMRGLIN=GMRGLIN+1
WRITE !,$SELECT(GMRGPRT:"**",1:""),?4,$SELECT('$DATA(^GMRD(124.2,"ATY",3,$PIECE(GMRGSEL,"^"))):"+",1:" "),$JUSTIFY((GMRG1),2),". "
+3 SET GMRGXPRT=$PIECE(GMRGSEL,"^",2)
SET GMRGXPRT(0)=$PIECE(GMRGPRT(0),"^",2)
SET GMRGXPRT(1)="9^"_IOM_"^1^"_$SELECT(GMRGPRT&GMRGIO("S")&'$PIECE(GMRGSITE(0),"^",2):1,1:0)_"^"
DO EN1^GMRGRUT2
+4 SET GMRGTLC=$Y
+5 KILL GMRGHPRT
IF $DATA(^GMRD(124.2,$PIECE(GMRGSEL,"^"),10))
XECUTE ^(10)
+6 FOR X=0:0
SET X=$ORDER(GMRGHPRT(X))
if X'>0
QUIT
WRITE ?(+GMRGHPRT(X)),$PIECE(GMRGHPRT(X),"^",2)
+7 SET GMRGTLC=$Y-GMRGTLC
IF GMRGTLC>0
SET GMRGLIN=GMRGLIN+GMRGTLC
+8 QUIT
PARSEL ;
+1 WRITE !!,"Please make the appropriate selections from this screen before continuing onto",!,"the next screen. "
DO PROMPT^GMRGED3
READ GMRGS:DTIME
+2 if GMRGS="^"!(GMRGS="^^")!'$TEST
SET GMRGOUT=1
if GMRGOUT
QUIT
SET GMRGSTAR(1)=GMRG1
SET GMRGPSEL=1
DO PSEL^GMRGED1
IF 'GMRGOOD
if GMRGMSR
GOTO PARSEL
QUIT
+3 SET GMRGSTAR(2)=GMRGSTAR(2)+1
SET GMRGSTAR=GMRGSTAR(1)-1
+4 QUIT
