GMRCP5C ;SLC/DCM,RJS - Print Consult form 513 (Assemble Segments And Print) ;4/30/98 09:41
;;3.0;CONSULT/REQUEST TRACKING;**4**;Dec 27, 1997
;
Q
;
ASSMBL(PAGELEN,PAGEWID) ;
;
N GMRCHDR,GMRCPG,SUB,GMRCPAGE,GMRCDVL
;
S GMRCDVL="",$P(GMRCDVL,"-",PAGEWID+1)=""
S ^TMP("GMRC",$J,"SF513")=$G(PAGELEN)
S GMRCPG=1,GMRCHDR=""
D CLRZONE(0)
D MERGE("HDR",0,1)
D MERGE("FTR",0,5)
;
;REQ add reason for request segment
;
D FORMAT("REQ",PAGELEN,PAGEWID,2)
;
;PDIAG add provisional diagnosis segment
;
D FORMAT("PDIAG",PAGELEN,PAGEWID,$$SIZE("PDIAG",1)+1)
;
;RES add tiu results segment
;
D FORMAT("RES",PAGELEN,PAGEWID,6)
;
;ADD add addendum segment
;
D FORMAT("ADD",PAGELEN,PAGEWID,4)
;
;SREP add service report segment
;
D FORMAT("SREP",PAGELEN,PAGEWID,5)
;
;COM add comments segment
;
D FORMAT("COM",PAGELEN,PAGEWID,5)
;
I $D(GMRCPAGE(300000)) D OUTPUT(GMRCPG)
;
Q
;
FORMAT(SUB,PAGELEN,PAGEWID,OFFSET) ;
;
N LN,NDX
;
I $$CHKPAGE("",0,PAGELEN,OFFSET) D CLRZONE(2)
I $O(^TMP("GMRC",$J,"OUTPUT",SUB,0)),$D(GMRCPAGE(300000)),'(SUB="RES") D BLDPAGE(3,GMRCDVL,PAGEWID)
;
S NDX=0 F S NDX=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX)) Q:'NDX D
.I $$CHKPAGE(SUB,NDX,PAGELEN,OFFSET) D CLRZONE(2)
.D NEWSUB("F",SUB,NDX,PAGEWID)
.S LN=0 F S LN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN)) Q:'LN D
..I $$CHKPAGE(SUB,NDX,PAGELEN,2)
..D BLDPAGE(3,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
.D BLDPAGE(3," ",PAGEWID,"",SUB,NDX)
.D ADDFTR(SUB,NDX,PAGEWID)
;
Q
;
NEWSUB(ZONE,SUB,NDX,PAGEWID) ;
;
N FLN,NZONE
;
S:(ZONE="H") NZONE=2
S:(ZONE="F") NZONE=4
Q:'$G(NZONE)
D CLRZONE(NZONE)
;
S FLN=0 F S FLN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN)) Q:'FLN D
.D BLDPAGE(NZONE,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,ZONE,FLN,1)),SUB,NDX)
Q
;
ADDFTR(SUB,NDX,PAGEWID) ;
;
N FLN
D CLRZONE(4)
S FLN=0 F S FLN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN)) Q:'FLN D
.D BLDPAGE(3,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,"F",FLN,1)),SUB,NDX)
Q
;
NEWPAGE(SUB,NDX) ;
;
N GMRCHDR
;
D OUTPUT(GMRCPG)
;
S GMRCPG=GMRCPG+1
D MERGE("HDR",1,1)
D MERGE("FTR",1,5)
;
I $L(SUB) D NEWSUB("H",SUB,NDX,PAGEWID)
Q
;
CHKPAGE(SUB,NDX,PAGELEN,OFFSET) ;
;
I ($$ROOM(PAGELEN)<OFFSET) D NEWPAGE(SUB,NDX) Q 1
Q 0
;
SIZE(SUB,NDX) ;
;
Q $O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX," "),-1)
;
ROOM(LEN) ;
;
N LN,SIZE
S LN=0 F SIZE=0:1 S LN=$O(GMRCPAGE(LN)) Q:'LN
Q (LEN-SIZE-1)
;
MERGE(SUB,NDX,ZONE) ;
;
N LN
S LN=0 F S LN=$O(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN)) Q:'LN D
.D BLDPAGE(ZONE,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$G(^TMP("GMRC",$J,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
Q
;
BLDPAGE(ZONE,TEXT,PAGEWID,RUNTIME,SUB,NDX) ;
;
N GMRCX,GMRCL,GMRCR1,GMRCR2,PTR,WORD
;
I ($L(TEXT)<PAGEWID) D ADDLN(ZONE,TEXT,$G(RUNTIME)) Q
;
F PTR=1:1 Q:(PTR>$L(TEXT," ")) I ($L($P(TEXT," ",PTR))>PAGEWID) D
.S WORD=$P(TEXT," ",PTR)
.S WORD=$E(WORD,1,PAGEWID)_" "_$E(WORD,(PAGEWID+1),$L(WORD))
.S $P(TEXT," ",PTR)=WORD,PTR=1
;
F PTR=2:1:$L(TEXT," ") Q:'$L(TEXT) I ($L($P(TEXT," ",1,PTR))>PAGEWID) D
.I (ZONE=3),$$CHKPAGE(SUB,NDX,PAGELEN,2)
.S (GMRCR1,GMRCR2)=""
.I $L(RUNTIME) D
..S GMRCL=$L($P(TEXT," ",1,PTR-1))
..F GMRCX=1:2:$L(RUNTIME,",") D
...I ($P(RUNTIME,",",GMRCX+1)>GMRCL) D I 1
....S:$L(GMRCR2) GMRCR2=GMRCR2_","
....S GMRCR2=GMRCR2_$P(RUNTIME,",",GMRCX)_","_($P(RUNTIME,",",GMRCX+1)-GMRCL)
...E D
....S:$L(GMRCR1) GMRCR1=GMRCR1_","
....S GMRCR1=GMRCR1_$P(RUNTIME,",",GMRCX,GMRCX+1)
.D ADDLN(ZONE,$P(TEXT," ",1,PTR-1),GMRCR1)
.S TEXT=$P(TEXT," ",PTR,$L(TEXT," ")),PTR=1,RUNTIME=GMRCR2
I $L(TEXT) S:(ZONE=3) GMRCX=$$CHKPAGE($G(SUB),$G(NDX),PAGELEN,2) D ADDLN(ZONE,TEXT,$G(RUNTIME))
Q
;
ADDLN(ZONE,TEXT,RUNTIME) ;
;
N NEXTLN
I '$D(GMRCPAGE(ZONE*100000)) S GMRCPAGE(ZONE*100000,0)=TEXT Q
S NEXTLN=$O(GMRCPAGE(ZONE*100000+99999),-1)+1
S GMRCPAGE(NEXTLN,0)=TEXT
S:$L($G(RUNTIME)) GMRCPAGE(NEXTLN,1)=RUNTIME
Q
;
OUTPUT(GMRCPG) ;
;
N LN,LN1,NEXT,ZONE,VAR,PTR
S LN=0 F S LN=$O(GMRCPAGE(LN)) Q:'LN I $O(GMRCPAGE(LN,0)) D
.S LN1=0 F S LN1=$O(GMRCPAGE(LN,LN1)) Q:'LN1 D
..S VAR=$G(GMRCPAGE(LN,LN1)) Q:'$L(VAR)
..S PTR=$P(VAR,",",2),VAR=$P(VAR,",",1)
..I PTR,$L(VAR),($D(@VAR)#2) S $E(GMRCPAGE(LN,0),PTR+1,PTR+1+$L(@VAR))=@VAR
;
S NEXT=$O(^TMP("GMRC",$J,"SF513"," "),-1)+1
M ^TMP("GMRC",$J,"SF513",NEXT)=GMRCPAGE
F ZONE=1,2,3,5 D CLRZONE(ZONE)
Q
;
CLRZONE(ZONE) ;
;
; Zone 1 = Header
; Zone 2 = SubHeader (Continuation Information)
; Zone 3 = Body of the Consult
; Zone 4 = SubFooter (Signature Information)
; Zone 5 = Footer
;
I '$G(ZONE) K GMRCPAGE Q
N LN,STLN,ENDLN
S STLN=100000*ZONE,ENDLN=STLN+99999
S LN=STLN D F S LN=$O(GMRCPAGE(LN)) Q:'LN Q:(LN>ENDLN) D
.K GMRCPAGE(LN)
Q
;
PRINT(PAGELEN,PAGEWID) ; Print the Consult
;
N GMRCPAGE,LN,LN1,VAR,PAGE,PAUSE,PTR,ROOM,LNCNT
;
S PAGE=0 F S PAGE=$O(^TMP("GMRC",$J,"SF513",PAGE)) Q:'PAGE D Q:(PAUSE[U)
.W:(PAGE>1) @IOF
.K GMRCPAGE M GMRCPAGE=^TMP("GMRC",$J,"SF513",PAGE)
.S ROOM=$$ROOM(PAGELEN)
.I (ROOM<100) F LN=1:1:ROOM D BLDPAGE(3," ",PAGEWID)
.S GMRCPG=PAGE_" of "_$O(^TMP("GMRC",$J,"SF513"," "),-1)
.S LN=0 F LNCNT=0:1 S LN=$O(GMRCPAGE(LN)) Q:'LN D
..S LN1=0 F S LN1=$O(GMRCPAGE(LN,LN1)) Q:'LN1 D
...S VAR=$G(GMRCPAGE(LN,LN1)) Q:'$L(VAR)
...S PTR=$P(VAR,",",2),VAR=$P(VAR,",",1)
...I PTR,$L(VAR),($D(@VAR)#2) D
....S $E(GMRCPAGE(LN,0),PTR+1,PTR+1+$L(@VAR))=@VAR
..W !,$G(GMRCPAGE(LN,0))
.;
.S PAUSE=0
.S:$O(^TMP("GMRC",$J,"SF513",PAGE)) PAUSE=PAUSE+1
.S:$O(^TMP("GMRC",$J,"SF513",PAGE),-1) PAUSE=PAUSE+10
.S PAUSE=$$PAUSE(PAUSE,PAGE)
.S:(PAUSE["-") PAGE=PAGE-2
;
Q
;
PAUSE(PF,PG) ; Pause After Each Screen for CRT's
;
N X,C
Q:'$$CRT ""
;
W !," Press: "
;
I (PF=00) W "<Enter> To Quit (^) To Quit : "
I (PF=01) W "<Enter> For Next Page (^) To Quit : "
I (PF=10) W "<Enter> To Quit (-) For Previous Page (^) To Quit : "
I (PF=11) W "<Enter> For Next Page (-) For Previous Page (^) To Quit : "
;
R X:DTIME E W " (timeout)" Q U
W !
Q X
;
CRT() ; IS THE PRINT DEVICE A CRT ?
Q:TIUFLG 0 Q ($E(IOST,1,2)="C-")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCP5C 6462 printed Sep 23, 2025@19:22:34 Page 2
GMRCP5C ;SLC/DCM,RJS - Print Consult form 513 (Assemble Segments And Print) ;4/30/98 09:41
+1 ;;3.0;CONSULT/REQUEST TRACKING;**4**;Dec 27, 1997
+2 ;
+3 QUIT
+4 ;
ASSMBL(PAGELEN,PAGEWID) ;
+1 ;
+2 NEW GMRCHDR,GMRCPG,SUB,GMRCPAGE,GMRCDVL
+3 ;
+4 SET GMRCDVL=""
SET $PIECE(GMRCDVL,"-",PAGEWID+1)=""
+5 SET ^TMP("GMRC",$JOB,"SF513")=$GET(PAGELEN)
+6 SET GMRCPG=1
SET GMRCHDR=""
+7 DO CLRZONE(0)
+8 DO MERGE("HDR",0,1)
+9 DO MERGE("FTR",0,5)
+10 ;
+11 ;REQ add reason for request segment
+12 ;
+13 DO FORMAT("REQ",PAGELEN,PAGEWID,2)
+14 ;
+15 ;PDIAG add provisional diagnosis segment
+16 ;
+17 DO FORMAT("PDIAG",PAGELEN,PAGEWID,$$SIZE("PDIAG",1)+1)
+18 ;
+19 ;RES add tiu results segment
+20 ;
+21 DO FORMAT("RES",PAGELEN,PAGEWID,6)
+22 ;
+23 ;ADD add addendum segment
+24 ;
+25 DO FORMAT("ADD",PAGELEN,PAGEWID,4)
+26 ;
+27 ;SREP add service report segment
+28 ;
+29 DO FORMAT("SREP",PAGELEN,PAGEWID,5)
+30 ;
+31 ;COM add comments segment
+32 ;
+33 DO FORMAT("COM",PAGELEN,PAGEWID,5)
+34 ;
+35 IF $DATA(GMRCPAGE(300000))
DO OUTPUT(GMRCPG)
+36 ;
+37 QUIT
+38 ;
FORMAT(SUB,PAGELEN,PAGEWID,OFFSET) ;
+1 ;
+2 NEW LN,NDX
+3 ;
+4 IF $$CHKPAGE("",0,PAGELEN,OFFSET)
DO CLRZONE(2)
+5 IF $ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,0))
IF $DATA(GMRCPAGE(300000))
IF '(SUB="RES")
DO BLDPAGE(3,GMRCDVL,PAGEWID)
+6 ;
+7 SET NDX=0
FOR
SET NDX=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX))
if 'NDX
QUIT
Begin DoDot:1
+8 IF $$CHKPAGE(SUB,NDX,PAGELEN,OFFSET)
DO CLRZONE(2)
+9 DO NEWSUB("F",SUB,NDX,PAGEWID)
+10 SET LN=0
FOR
SET LN=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN))
if 'LN
QUIT
Begin DoDot:2
+11 IF $$CHKPAGE(SUB,NDX,PAGELEN,2)
+12 DO BLDPAGE(3,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
End DoDot:2
+13 DO BLDPAGE(3," ",PAGEWID,"",SUB,NDX)
+14 DO ADDFTR(SUB,NDX,PAGEWID)
End DoDot:1
+15 ;
+16 QUIT
+17 ;
NEWSUB(ZONE,SUB,NDX,PAGEWID) ;
+1 ;
+2 NEW FLN,NZONE
+3 ;
+4 if (ZONE="H")
SET NZONE=2
+5 if (ZONE="F")
SET NZONE=4
+6 if '$GET(NZONE)
QUIT
+7 DO CLRZONE(NZONE)
+8 ;
+9 SET FLN=0
FOR
SET FLN=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,ZONE,FLN))
if 'FLN
QUIT
Begin DoDot:1
+10 DO BLDPAGE(NZONE,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,ZONE,FLN,0)),PAGEWID,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,ZONE,FLN,1)),SUB,NDX)
End DoDot:1
+11 QUIT
+12 ;
ADDFTR(SUB,NDX,PAGEWID) ;
+1 ;
+2 NEW FLN
+3 DO CLRZONE(4)
+4 SET FLN=0
FOR
SET FLN=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,"F",FLN))
if 'FLN
QUIT
Begin DoDot:1
+5 DO BLDPAGE(3,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,"F",FLN,0)),PAGEWID,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,"F",FLN,1)),SUB,NDX)
End DoDot:1
+6 QUIT
+7 ;
NEWPAGE(SUB,NDX) ;
+1 ;
+2 NEW GMRCHDR
+3 ;
+4 DO OUTPUT(GMRCPG)
+5 ;
+6 SET GMRCPG=GMRCPG+1
+7 DO MERGE("HDR",1,1)
+8 DO MERGE("FTR",1,5)
+9 ;
+10 IF $LENGTH(SUB)
DO NEWSUB("H",SUB,NDX,PAGEWID)
+11 QUIT
+12 ;
CHKPAGE(SUB,NDX,PAGELEN,OFFSET) ;
+1 ;
+2 IF ($$ROOM(PAGELEN)<OFFSET)
DO NEWPAGE(SUB,NDX)
QUIT 1
+3 QUIT 0
+4 ;
SIZE(SUB,NDX) ;
+1 ;
+2 QUIT $ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX," "),-1)
+3 ;
ROOM(LEN) ;
+1 ;
+2 NEW LN,SIZE
+3 SET LN=0
FOR SIZE=0:1
SET LN=$ORDER(GMRCPAGE(LN))
if 'LN
QUIT
+4 QUIT (LEN-SIZE-1)
+5 ;
MERGE(SUB,NDX,ZONE) ;
+1 ;
+2 NEW LN
+3 SET LN=0
FOR
SET LN=$ORDER(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN))
if 'LN
QUIT
Begin DoDot:1
+4 DO BLDPAGE(ZONE,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN,0)),PAGEWID,$GET(^TMP("GMRC",$JOB,"OUTPUT",SUB,NDX,LN,1)),SUB,NDX)
End DoDot:1
+5 QUIT
+6 ;
BLDPAGE(ZONE,TEXT,PAGEWID,RUNTIME,SUB,NDX) ;
+1 ;
+2 NEW GMRCX,GMRCL,GMRCR1,GMRCR2,PTR,WORD
+3 ;
+4 IF ($LENGTH(TEXT)<PAGEWID)
DO ADDLN(ZONE,TEXT,$GET(RUNTIME))
QUIT
+5 ;
+6 FOR PTR=1:1
if (PTR>$LENGTH(TEXT," "))
QUIT
IF ($LENGTH($PIECE(TEXT," ",PTR))>PAGEWID)
Begin DoDot:1
+7 SET WORD=$PIECE(TEXT," ",PTR)
+8 SET WORD=$EXTRACT(WORD,1,PAGEWID)_" "_$EXTRACT(WORD,(PAGEWID+1),$LENGTH(WORD))
+9 SET $PIECE(TEXT," ",PTR)=WORD
SET PTR=1
End DoDot:1
+10 ;
+11 FOR PTR=2:1:$LENGTH(TEXT," ")
if '$LENGTH(TEXT)
QUIT
IF ($LENGTH($PIECE(TEXT," ",1,PTR))>PAGEWID)
Begin DoDot:1
+12 IF (ZONE=3)
IF $$CHKPAGE(SUB,NDX,PAGELEN,2)
+13 SET (GMRCR1,GMRCR2)=""
+14 IF $LENGTH(RUNTIME)
Begin DoDot:2
+15 SET GMRCL=$LENGTH($PIECE(TEXT," ",1,PTR-1))
+16 FOR GMRCX=1:2:$LENGTH(RUNTIME,",")
Begin DoDot:3
+17 IF ($PIECE(RUNTIME,",",GMRCX+1)>GMRCL)
Begin DoDot:4
+18 if $LENGTH(GMRCR2)
SET GMRCR2=GMRCR2_","
+19 SET GMRCR2=GMRCR2_$PIECE(RUNTIME,",",GMRCX)_","_($PIECE(RUNTIME,",",GMRCX+1)-GMRCL)
End DoDot:4
IF 1
+20 IF '$TEST
Begin DoDot:4
+21 if $LENGTH(GMRCR1)
SET GMRCR1=GMRCR1_","
+22 SET GMRCR1=GMRCR1_$PIECE(RUNTIME,",",GMRCX,GMRCX+1)
End DoDot:4
End DoDot:3
End DoDot:2
+23 DO ADDLN(ZONE,$PIECE(TEXT," ",1,PTR-1),GMRCR1)
+24 SET TEXT=$PIECE(TEXT," ",PTR,$LENGTH(TEXT," "))
SET PTR=1
SET RUNTIME=GMRCR2
End DoDot:1
+25 IF $LENGTH(TEXT)
if (ZONE=3)
SET GMRCX=$$CHKPAGE($GET(SUB),$GET(NDX),PAGELEN,2)
DO ADDLN(ZONE,TEXT,$GET(RUNTIME))
+26 QUIT
+27 ;
ADDLN(ZONE,TEXT,RUNTIME) ;
+1 ;
+2 NEW NEXTLN
+3 IF '$DATA(GMRCPAGE(ZONE*100000))
SET GMRCPAGE(ZONE*100000,0)=TEXT
QUIT
+4 SET NEXTLN=$ORDER(GMRCPAGE(ZONE*100000+99999),-1)+1
+5 SET GMRCPAGE(NEXTLN,0)=TEXT
+6 if $LENGTH($GET(RUNTIME))
SET GMRCPAGE(NEXTLN,1)=RUNTIME
+7 QUIT
+8 ;
OUTPUT(GMRCPG) ;
+1 ;
+2 NEW LN,LN1,NEXT,ZONE,VAR,PTR
+3 SET LN=0
FOR
SET LN=$ORDER(GMRCPAGE(LN))
if 'LN
QUIT
IF $ORDER(GMRCPAGE(LN,0))
Begin DoDot:1
+4 SET LN1=0
FOR
SET LN1=$ORDER(GMRCPAGE(LN,LN1))
if 'LN1
QUIT
Begin DoDot:2
+5 SET VAR=$GET(GMRCPAGE(LN,LN1))
if '$LENGTH(VAR)
QUIT
+6 SET PTR=$PIECE(VAR,",",2)
SET VAR=$PIECE(VAR,",",1)
+7 IF PTR
IF $LENGTH(VAR)
IF ($DATA(@VAR)#2)
SET $EXTRACT(GMRCPAGE(LN,0),PTR+1,PTR+1+$LENGTH(@VAR))=@VAR
End DoDot:2
End DoDot:1
+8 ;
+9 SET NEXT=$ORDER(^TMP("GMRC",$JOB,"SF513"," "),-1)+1
+10 MERGE ^TMP("GMRC",$JOB,"SF513",NEXT)=GMRCPAGE
+11 FOR ZONE=1,2,3,5
DO CLRZONE(ZONE)
+12 QUIT
+13 ;
CLRZONE(ZONE) ;
+1 ;
+2 ; Zone 1 = Header
+3 ; Zone 2 = SubHeader (Continuation Information)
+4 ; Zone 3 = Body of the Consult
+5 ; Zone 4 = SubFooter (Signature Information)
+6 ; Zone 5 = Footer
+7 ;
+8 IF '$GET(ZONE)
KILL GMRCPAGE
QUIT
+9 NEW LN,STLN,ENDLN
+10 SET STLN=100000*ZONE
SET ENDLN=STLN+99999
+11 SET LN=STLN
Begin DoDot:1
+12 KILL GMRCPAGE(LN)
End DoDot:1
FOR
SET LN=$ORDER(GMRCPAGE(LN))
if 'LN
QUIT
if (LN>ENDLN)
QUIT
Begin DoDot:1
End DoDot:1
+13 QUIT
+14 ;
PRINT(PAGELEN,PAGEWID) ; Print the Consult
+1 ;
+2 NEW GMRCPAGE,LN,LN1,VAR,PAGE,PAUSE,PTR,ROOM,LNCNT
+3 ;
+4 SET PAGE=0
FOR
SET PAGE=$ORDER(^TMP("GMRC",$JOB,"SF513",PAGE))
if 'PAGE
QUIT
Begin DoDot:1
+5 if (PAGE>1)
WRITE @IOF
+6 KILL GMRCPAGE
MERGE GMRCPAGE=^TMP("GMRC",$JOB,"SF513",PAGE)
+7 SET ROOM=$$ROOM(PAGELEN)
+8 IF (ROOM<100)
FOR LN=1:1:ROOM
DO BLDPAGE(3," ",PAGEWID)
+9 SET GMRCPG=PAGE_" of "_$ORDER(^TMP("GMRC",$JOB,"SF513"," "),-1)
+10 SET LN=0
FOR LNCNT=0:1
SET LN=$ORDER(GMRCPAGE(LN))
if 'LN
QUIT
Begin DoDot:2
+11 SET LN1=0
FOR
SET LN1=$ORDER(GMRCPAGE(LN,LN1))
if 'LN1
QUIT
Begin DoDot:3
+12 SET VAR=$GET(GMRCPAGE(LN,LN1))
if '$LENGTH(VAR)
QUIT
+13 SET PTR=$PIECE(VAR,",",2)
SET VAR=$PIECE(VAR,",",1)
+14 IF PTR
IF $LENGTH(VAR)
IF ($DATA(@VAR)#2)
Begin DoDot:4
+15 SET $EXTRACT(GMRCPAGE(LN,0),PTR+1,PTR+1+$LENGTH(@VAR))=@VAR
End DoDot:4
End DoDot:3
+16 WRITE !,$GET(GMRCPAGE(LN,0))
End DoDot:2
+17 ;
+18 SET PAUSE=0
+19 if $ORDER(^TMP("GMRC",$JOB,"SF513",PAGE))
SET PAUSE=PAUSE+1
+20 if $ORDER(^TMP("GMRC",$JOB,"SF513",PAGE),-1)
SET PAUSE=PAUSE+10
+21 SET PAUSE=$$PAUSE(PAUSE,PAGE)
+22 if (PAUSE["-")
SET PAGE=PAGE-2
End DoDot:1
if (PAUSE[U)
QUIT
+23 ;
+24 QUIT
+25 ;
PAUSE(PF,PG) ; Pause After Each Screen for CRT's
+1 ;
+2 NEW X,C
+3 if '$$CRT
QUIT ""
+4 ;
+5 WRITE !," Press: "
+6 ;
+7 IF (PF=00)
WRITE "<Enter> To Quit (^) To Quit : "
+8 IF (PF=01)
WRITE "<Enter> For Next Page (^) To Quit : "
+9 IF (PF=10)
WRITE "<Enter> To Quit (-) For Previous Page (^) To Quit : "
+10 IF (PF=11)
WRITE "<Enter> For Next Page (-) For Previous Page (^) To Quit : "
+11 ;
+12 READ X:DTIME
IF '$TEST
WRITE " (timeout)"
QUIT U
+13 WRITE !
+14 QUIT X
+15 ;
CRT() ; IS THE PRINT DEVICE A CRT ?
+1 if TIUFLG
QUIT 0
QUIT ($EXTRACT(IOST,1,2)="C-")
+2 ;
