Routine: GMRGED8

GMRGED8 ;HIRMFO/JH,RM-PATIENT DATA EDIT (cont.) ;9/1/95

 ;;3.0;Text Generator;;Jan 24, 1996

EN1 ;Entry point for building Split Screen Array ( ^TMP($J,"GMR",I) )

 ;from a single array GMRGSEL( ) passed from the calling routine.

 K ^TMP($J,"GMR"),^("GMR1") S ^TMP($J,"GMR",0)=""

 S J=1,GMRGSELC=0 F L=0:0 S L=$O(GMRGSEL(L)) Q:L=""  D BRK G QUIT:GMRGOUT

 D:$O(GMRGSEL(0)) PAD G QUIT

BRK S GMRGPRT=$P(GMRGSEL(L),"^",3),GMRGSEL=GMRGSEL(L),GMRGPRT(0)=$S($D(GMRGSEL(L,1)):GMRGSEL(L,1),1:""),GMRGXPRT=$P(GMRGSEL,"^",2),GMRGXPRT(0)=$P(GMRGPRT(0),"^",2),GMRGXPRT(1)="^^1^"_(GMRGIO("S")&'$P(GMRGSITE(0),"^",2))_"^1" D EN1^GMRGRUT2

 S GMRGLEN=29,GMRGPL=$S($P(GMRGSEL(L),"^",3)=1:1_"^** ",1:0_"^   ")_$S($D(^GMRD(124.2,"ATY",2,$P(GMRGSEL(L),"^"))):"+",1:" ")_$J(L,2)_".  ^",GMRGPLN=GMRGXPRT D BRK1

BRK1 F I=1:1 Q:GMRGPLN=""  D FITLINE^GMRGRUT1 S ^TMP($J,"GMR1",J)=GMRGPL_GMRGPLN(0) S GMRGPL=$S($P(GMRGSEL(L),"^",3)=1:1_"^         ^",1:0_"^         ^"),GMRGPLN=GMRGPLN(1),GMRGLEN=29,J=J+1

ADD ;Check for added text

 K GMRGHPRT X:$D(^GMRD(124.2,+GMRGSEL(L),10)) ^(10) Q:GMRGOUT!'$D(GMRGHPRT)

 S GMRGHPR=$S($D(GMRGHPRT(1)):GMRGHPRT(1),1:""),GMRGCOL=$S($P(GMRGHPR,"^")<0:0,$P(GMRGHPR,"^")>17:17,1:GMRGHPR),GMRGPLN=$P(GMRGHPR,"^",2) S GMRGSPP="",GMRGSP=" " F JJ=1:1:GMRGCOL-1 S GMRGSPP=GMRGSPP_GMRGSP

 S GMRGPL=0_"^         ^"_GMRGSPP D REST,NUR

REST S GMRGLEN=29 D FITLINE^GMRGRUT1 F GMRG1=0:0 S ^TMP($J,"GMR1",J)=GMRGPL_GMRGPLN(0),J=J+1 D PAD:J=29 Q:GMRGPLN(1)=""  S GMRGPL=0_"^"_GMRGSPP,GMRGPLN=GMRGPLN(1),GMRGLEN=29 D FITLINE^GMRGRUT1

PAD ;Pack Utility Array into Split Screen Format

 S GMRGSTAR(0)="",J=J-1,(JJ,LL)=1 F I=1:1 S GMRGSTAR(0,I)=JJ-1 D PAGE Q:LL>J

PRN ;Entery point to print one (1) line from Split Screen Array,

 ;with I equal to the ien number of line to be printed.

 S GMRGXPRT(1)="^^^"_GMRGIO("S")_"^^"_$P(GMRGSITE(0),"^",2),GMRGXPRT(4)=GMRGIO("RVON"),GMRGXPRT(5)=GMRGIO("RVOF")

 W !,$P(^TMP($J,"GMR",I),"^",2) S GMRGXPRT=$P(^(I),"^",3) D HION^GMRGRUT2:$P(^(I),"^")=1 W GMRGXPRT D HIOF^GMRGRUT2:$P(^TMP($J,"GMR",I),"^")=1

 W:$P(^TMP($J,"GMR",I),"^",6)'="" ?40,$P(^(I),"^",5) S GMRGXPRT=$P(^(I),"^",6) D HION^GMRGRUT2:$P(^(I),"^",4)=1 W GMRGXPRT D HIOF^GMRGRUT2:$P(^TMP($J,"GMR",I),"^",4)=1

 S X=$P(^TMP($J,"GMR",I),"^",5) I X?.E1N.E F Y=1:1:$L(X) Q:$E(X)?1N  S X=$E(X,2,$L(X))

 S:X GMRGSTAR(3)=+X K GMRGXPRT Q

NUR ;Check For Additional Text

 I 'GMRGOUT,$P(GMRGTERM(0),"^",9) S ^TMP($J,"GMR1",J)="Additional Text: " S J=J+1 I $S($P(GMRGTERM,"^",3)="":0,1:1) D NUR1

NUR1 S GMRGPL="         ^",GMRGPLN=$S(+$P(GMRGTERM,"^",3)'>0:"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),"ADD")):^("ADD"),1:"") S GMRGSPP="" D REST

QUIT K I,J,JJ,K,L,M,N,O,GMRG1,GMRGSP,GMRGSPP,GMRGSPLI,GMRGS,GMRGPL,GMRGPLN,GMRGCOL,GMRGHPR,GMRGHPRT,GMRGXPRT,GMRLINS,^TMP($J,"GMR1") Q

PAGE ;

 S II=$S(J-LL+1>28:14,1:J-LL+2\2)-1,M=LL,MM=LL+II F II=II:0 D NXT1 Q:LL-M>14  S MM=LL Q:LL>II  S LL=LL+1 Q:'$D(^TMP($J,"GMR1",LL))

 S LL=MM+1,O=LL,OO=LL+II F II=II:0 D NXT1 Q:(LL-O)>14  S OO=LL Q:(LL-MM)>II  S LL=LL+1 Q:'$D(^TMP($J,"GMR1",LL))

 S L=$S((MM-M)>(OO-O):MM-M,1:OO-O),LL=OO+1

 F JJ=JJ:1:(JJ+L) S ^TMP($J,"GMR",JJ)=$S(M'>MM:$G(^TMP($J,"GMR1",M)),1:"^^")_"^"_$S(O'>OO:$G(^TMP($J,"GMR1",O)),1:""),O=O+1,M=M+1

 S JJ=JJ+1 Q

NXT1 ;

 Q:$S('$D(^TMP($J,"GMR1",LL+1)):1,$P(^(LL+1),"^",2)?.E1N.E:1,1:0)

 S LL=LL+1

 G NXT1

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRGED8   3356     printed  Feb 18, 2025@23:21:43                                                                                                                                                                                                     Page 2

GMRGED8   ;HIRMFO/JH,RM-PATIENT DATA EDIT (cont.) ;9/1/95

 +1       ;;3.0;Text Generator;;Jan 24, 1996

EN1       ;Entry point for building Split Screen Array ( ^TMP($J,"GMR",I) )

 +1       ;from a single array GMRGSEL( ) passed from the calling routine.

 +2       ;

 +3        KILL ^TMP($JOB,"GMR"),^("GMR1")

           SET ^TMP($JOB,"GMR",0)=""

 +4        SET J=1

           SET GMRGSELC=0

           FOR L=0:0

               SET L=$ORDER(GMRGSEL(L))

               if L=""

                   QUIT

               DO BRK

               if GMRGOUT

                   GOTO QUIT

 +5        if $ORDER(GMRGSEL(0))

               DO PAD

           GOTO QUIT

BRK        SET GMRGPRT=$PIECE(GMRGSEL(L),"^",3)

           SET GMRGSEL=GMRGSEL(L)

           SET GMRGPRT(0)=$SELECT($DATA(GMRGSEL(L,1)):GMRGSEL(L,1),1:"")

           SET GMRGXPRT=$PIECE(GMRGSEL,"^",2)

           SET GMRGXPRT(0)=$PIECE(GMRGPRT(0),"^",2)

           SET GMRGXPRT(1)="^^1^"_(GMRGIO("S")&'$PIECE(GMRGSITE(0),"^",2))_"^1"

           DO EN1^GMRGRUT2

 +1        SET GMRGLEN=29

           SET GMRGPL=$SELECT($PIECE(GMRGSEL(L),"^",3)=1:1_"^** ",1:0_"^   ")_$SELECT($DATA(^GMRD(124.2,"ATY",2,$PIECE(GMRGSEL(L),"^"))):"+",1:" ")_$JUSTIFY(L,2)_".  ^"

           SET GMRGPLN=GMRGXPRT

           DO BRK1

 +2        QUIT

BRK1       FOR I=1:1

               if GMRGPLN=""

                   QUIT

               DO FITLINE^GMRGRUT1

               SET ^TMP($JOB,"GMR1",J)=GMRGPL_GMRGPLN(0)

               SET GMRGPL=$SELECT($PIECE(GMRGSEL(L),"^",3)=1:1_"^         ^",1:0_"^         ^")

               SET GMRGPLN=GMRGPLN(1)

               SET GMRGLEN=29

               SET J=J+1

 +1       ;

ADD       ;Check for added text

 +1        KILL GMRGHPRT

           if $DATA(^GMRD(124.2,+GMRGSEL(L),10))

               XECUTE ^(10)

           if GMRGOUT!'$DATA(GMRGHPRT)

               QUIT

 +2        SET GMRGHPR=$SELECT($DATA(GMRGHPRT(1)):GMRGHPRT(1),1:"")

           SET GMRGCOL=$SELECT($PIECE(GMRGHPR,"^")<0:0,$PIECE(GMRGHPR,"^")>17:17,1:GMRGHPR)

           SET GMRGPLN=$PIECE(GMRGHPR,"^",2)

           SET GMRGSPP=""

           SET GMRGSP=" "

           FOR JJ=1:1:GMRGCOL-1

               SET GMRGSPP=GMRGSPP_GMRGSP

 +3        SET GMRGPL=0_"^         ^"_GMRGSPP

           DO REST

           DO NUR

 +4        QUIT

REST       SET GMRGLEN=29

           DO FITLINE^GMRGRUT1

           FOR GMRG1=0:0

               SET ^TMP($JOB,"GMR1",J)=GMRGPL_GMRGPLN(0)

               SET J=J+1

               if J=29

                   DO PAD

               if GMRGPLN(1)=""

                   QUIT

               SET GMRGPL=0_"^"_GMRGSPP

               SET GMRGPLN=GMRGPLN(1)

               SET GMRGLEN=29

               DO FITLINE^GMRGRUT1

 +1        QUIT

PAD       ;Pack Utility Array into Split Screen Format

 +1        SET GMRGSTAR(0)=""

           SET J=J-1

           SET (JJ,LL)=1

           FOR I=1:1

               SET GMRGSTAR(0,I)=JJ-1

               DO PAGE

               if LL>J

                   QUIT

 +2        QUIT

PRN       ;Entery point to print one (1) line from Split Screen Array,

 +1       ;with I equal to the ien number of line to be printed.

 +2       ;

 +3        SET GMRGXPRT(1)="^^^"_GMRGIO("S")_"^^"_$PIECE(GMRGSITE(0),"^",2)

           SET GMRGXPRT(4)=GMRGIO("RVON")

           SET GMRGXPRT(5)=GMRGIO("RVOF")

 +4        WRITE !,$PIECE(^TMP($JOB,"GMR",I),"^",2)

           SET GMRGXPRT=$PIECE(^(I),"^",3)

           if $PIECE(^(I),"^")=1

               DO HION^GMRGRUT2

           WRITE GMRGXPRT

           if $PIECE(^TMP($JOB,"GMR",I),"^")=1

               DO HIOF^GMRGRUT2

 +5        if $PIECE(^TMP($JOB,"GMR",I),"^",6)'=""

               WRITE ?40,$PIECE(^(I),"^",5)

           SET GMRGXPRT=$PIECE(^(I),"^",6)

           if $PIECE(^(I),"^",4)=1

               DO HION^GMRGRUT2

           WRITE GMRGXPRT

           if $PIECE(^TMP($JOB,"GMR",I),"^",4)=1

               DO HIOF^GMRGRUT2

 +6        SET X=$PIECE(^TMP($JOB,"GMR",I),"^",5)

           IF X?.E1N.E

               FOR Y=1:1:$LENGTH(X)

                   if $EXTRACT(X)?1N

                       QUIT

                   SET X=$EXTRACT(X,2,$LENGTH(X))

 +7        if X

               SET GMRGSTAR(3)=+X

           KILL GMRGXPRT

           QUIT

NUR       ;Check For Additional Text

 +1        IF 'GMRGOUT

               IF $PIECE(GMRGTERM(0),"^",9)

                   SET ^TMP($JOB,"GMR1",J)="Additional Text: "

                   SET J=J+1

                   IF $SELECT($PIECE(GMRGTERM,"^",3)="":0,1:1)

                       DO NUR1

 +2        QUIT

NUR1       SET GMRGPL="         ^"

           SET GMRGPLN=$SELECT(+$PIECE(GMRGTERM,"^",3)'>0:"",$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGTERM,"^",3),"ADD")):^("ADD"),1:"")

           SET GMRGSPP=""

           DO REST

 +1        QUIT

QUIT       KILL I,J,JJ,K,L,M,N,O,GMRG1,GMRGSP,GMRGSPP,GMRGSPLI,GMRGS,GMRGPL,GMRGPLN,GMRGCOL,GMRGHPR,GMRGHPRT,GMRGXPRT,GMRLINS,^TMP($JOB,"GMR1")

           QUIT

PAGE      ;

 +1        SET II=$SELECT(J-LL+1>28:14,1:J-LL+2\2)-1

           SET M=LL

           SET MM=LL+II

           FOR II=II:0

               DO NXT1

               if LL-M>14

                   QUIT

               SET MM=LL

               if LL>II

                   QUIT

               SET LL=LL+1

               if '$DATA(^TMP($JOB,"GMR1",LL))

                   QUIT

 +2        SET LL=MM+1

           SET O=LL

           SET OO=LL+II

           FOR II=II:0

               DO NXT1

               if (LL-O)>14

                   QUIT

               SET OO=LL

               if (LL-MM)>II

                   QUIT

               SET LL=LL+1

               if '$DATA(^TMP($JOB,"GMR1",LL))

                   QUIT

 +3        SET L=$SELECT((MM-M)>(OO-O):MM-M,1:OO-O)

           SET LL=OO+1

 +4        FOR JJ=JJ:1:(JJ+L)

               SET ^TMP($JOB,"GMR",JJ)=$SELECT(M'>MM:$GET(^TMP($JOB,"GMR1",M)),1:"^^")_"^"_$SELECT(O'>OO:$GET(^TMP($JOB,"GMR1",O)),1:"")

               SET O=O+1

               SET M=M+1

 +5        SET JJ=JJ+1

           QUIT

NXT1      ;

 +1        if $SELECT('$DATA(^TMP($JOB,"GMR1",LL+1))

               QUIT

 +2        SET LL=LL+1

 +3        GOTO NXT1

GMRGED8.m