source: FOIAVistA/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCP5C.m@ 1607

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-")
 ;