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