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
Q
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
Q
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
Q
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
Q
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
Q
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
Q
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 Dec 13, 2024@01:55:20 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
