TIUFLP1 ;SLC/AJB - TIU FORM LETTER PRINT; 06 MAR 07
;;1.0;TEXT INTEGRATION UTILITIES;**222**;Jun 20, 1997
Q
PRINT ; main entry point
N CONT,NDOC,TIUDA,TIUI,TIUJ,TIUPR
S CONT=1,NDOC=0,(TIUI,TIUJ)=""
S TIUPR=$NA(^TMP("TIUPR",$J))
F S TIUI=$O(@TIUPR@(TIUI)) Q:TIUI="" D Q:'+CONT
. F S TIUJ=$O(@TIUPR@(TIUI,TIUJ)) Q:TIUJ="" D Q:'+CONT
. . S TIUDA="" F S TIUDA=$O(@TIUPR@(TIUI,TIUJ,TIUDA)) Q:'+TIUDA D Q:'+CONT
. . . S NDOC=NDOC+1 I NDOC>1 W @IOF
. . . N DFN,NOL,PAGE,PAGES,TIU,TIUD9,TIUERR,TIUISADD,TIULQ,TIUPN,TIUPNL,TIUTYP,TIUY
. . . I '$D(^TIU(8925,+TIUDA,0)) D Q
. . . . W !,"Document #",TIUDA," no longer exists in the TIU DOCUMENT file.",!
. . . . S CONT=$$STOP
. . . S DFN=$P(^TIU(8925,TIUDA,0),U,2),PAGE=1,PAGES=""
. . . S TIULQ=$NA(^TMP("TIULQ",$J)) K @TIULQ D EXTRACT^TIULQ(+TIUDA,TIULQ,.TIUERR,"","",1)
. . . I +$G(TIUERR) W !,$P(TIUERR,U,2),! S CONT=$$STOP Q
. . . S TIULQ=$NA(^TMP("TIULQ",$J,TIUDA))
. . . S TIUTYP=+$G(^TIU(8925,+TIUDA,0))
. . . D SETUP(TIUTYP,TIUDA)
. . . D PAGES
. . . D REPORT Q:'+CONT I $E(IOST,1,2)="C-" D S CONT=$$STOP
. . . . F Q:$Y'<(IOSL-NOL("FTR")-$S(+TIUPN:1,1:0)-3) W !
. . . D ADDENDA Q:'+CONT I +$G(TIUISADD),$E(IOST,1,2)="C-" D S CONT=$$STOP
. . . . F Q:$Y'<(IOSL-NOL("FTR")-$S(+TIUPN:1,1:0)-3) W !
Q
CONTINUE() ; controls paging
I $E(IOST,1,2)="C-" G CONTY:$Y<(IOSL-NOL("FTR")-2) D S CONT=$$STOP G CONTX
. D HFCPNT("FTR")
G:$Y<(IOSL-NOL("FTR")) CONTY
I IOSL<250 F Q:$Y'<(IOSL-NOL("FTR")) W !
D HFCPNT("FTR") S:$E(IOST,1,2)="C-" CONT=$$STOP
CONTX I +CONT W @IOF
CONTY Q CONT
IDKID(TIUDA,KIDDA) ; print ID children note
N KNUM,NODE,NOL,PAGE,PAGES,TIU,TIULQ,TIUTYP
S PAGE=1,PAGES="",TIULQ=$NA(^TMP("TIULQ",$J,TIUDA)),TIUTYP=+$G(^TIU(8925,+KIDDA,0))
D SETUP(TIUTYP,KIDDA)
D IDPAGES
S KNUM=NOL(KIDDA),TIULQ=$NA(^TMP("TIULQ",$J,TIUDA,"ZZID",KNUM,KIDDA))
W @IOF
D REPORT
Q
IDPAGES ; calculates # of pages for ID child note
N IDK,ISKID,TIUX
S NOL="",NOL=$O(@TIULQ@("TEXT",NOL),-1),NOL("PARENT")=NOL ; # of lines in parent document
S IDK=0 F S IDK=$O(@TIULQ@("ZZID",IDK)) Q:'+IDK S NOL="",NOL=$O(@TIULQ@("ZZID",IDK,KIDDA,"TEXT",NOL),-1) I +NOL S NOL(KIDDA)=IDK,NOL("IDK",KIDDA)=(NOL-NOL("PARENT")) ; # of lines ID child
D IDK
S NOL("IDK",KIDDA)=NOL("IDK",KIDDA)+NOL("HDR")+NOL("CLS") ; add # of lines in ID child body,heading,closing
S PAGES=NOL("IDK",KIDDA)\(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) I +NOL("IDK",KIDDA)#(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) S PAGES=PAGES+1 ; calculate # of pages for ID child
Q
HFCPNT(NODE) ; heading,footer,closing print (page numbers optional)
N TIUI S TIUI=0 F S TIUI=$O(TIU(NODE,TIUI)) Q:TIUI=""!('+CONT) D
. I NODE="HDR" W TIU(NODE,TIUI,0),! Q
. I NODE="CLS" D Q
. . I $Y<(IOSL-$S($E(IOST,1,2)="C-":2,1:0)-$S(+TIUPN:2,1:0)) W TIU(NODE,TIUI,0),!
. . E D S:$E(IOST,1,2)="C-" CONT=$$STOP W @IOF
. . . I +TIUPN S TIUY="Page "_PAGE_" of "_PAGES S TIUY=$S(TIUPNL="CJ":$$CENTER^TIULS(TIUY),TIUPNL="RJ":$$SPACER(TIUY,IOM,1),1:TIUY) W !,TIUY S PAGE=PAGE+1,TIUI=TIUI-1
. I IOSL<250 F Q:$Y'<(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) W !
. W TIU(NODE,TIUI,0),!
Q:'+CONT
I NODE="FTR",+TIUPN S TIUY="Page "_PAGE_" of "_PAGES S TIUY=$S(TIUPNL="CJ":$$CENTER^TIULS(TIUY),TIUPNL="RJ":$$SPACER(TIUY,IOM,1),1:TIUY) W TIUY S PAGE=PAGE+1
Q
PAGES ; calculates total # of pages
N ADD,TIUX
S NOL="",NOL=$O(@TIULQ@("TEXT",NOL),-1),NOL("PARENT")=NOL ; # of lines in parent document
S ADD="" F S ADD=$O(@TIULQ@("ZADD",ADD)) Q:'+ADD S NOL="",NOL=$O(@TIULQ@("ZADD",ADD,"TEXT",NOL),-1) S NOL("ADD",ADD)=(NOL-NOL("PARENT")) ; # of lines in each addendum
IDK F NOL="HDR","FTR","CLS" S ADD="",NOL(NOL)=$O(TIU(NOL,ADD),-1) ; # of lines in heading,footer & closing
I +NOL("HDR") S TIU("HDR",(NOL("HDR")+1),0)=" ",NOL("HDR")=NOL("HDR")+1 F TIUX=1:1:+$P(TIUD9,U,6) S NOL("HDR")=NOL("HDR")+1,TIU("HDR",NOL("HDR"),0)=" " ; adds one blank line in header & # of lines desired by user
I '+NOL("HDR") F TIUX=1:1:+$P(TIUD9,U,6) S TIU("HDR",TIUX,0)=" ",NOL("HDR")=TIUX ; if no header, add # of lines desired by user
F NOL="FTR","CLS" I +NOL(NOL) D ; add blank line to beginning of footer & closing
. N TMP S TMP=0 F S TMP=$O(TIU(NOL,TMP)) Q:'+TMP S TMP(NOL,(TMP+1),0)=TIU(NOL,TMP,0)
. S TMP(NOL,1,0)=" " M TIU(NOL)=TMP(NOL)
. S NOL(NOL)=NOL(NOL)+1
I +NOL("FTR"),+TIUPN S NOL("FTR")=NOL("FTR")+1 ; if pages numbers, add one line to # of lines in the footer
I '+NOL("FTR"),+TIUPN S NOL("FTR")=1 ; if no footer and pages numbers, add one line to footer
I +$G(ISKID) Q
S NOL("PARENT")=NOL("PARENT")+NOL("HDR")+NOL("CLS") ; add # of lines in parent,heading & closing
S PAGES=NOL("PARENT")\(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) I +NOL("PARENT")#(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) S PAGES=PAGES+1 ; calculate # of pages for parent
S ADD="" F S ADD=$O(NOL("ADD",ADD)) Q:'+ADD D ; calculate # of pages for addenda (one page minimum per)
. N ADPAGES S ADPAGES=NOL("ADD",ADD)\(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) I +NOL("ADD",ADD)#(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0)) S ADPAGES=ADPAGES+1
. S PAGES=PAGES+ADPAGES
Q
REPORT ; print parent note
I PAGE=1 D HFCPNT("HDR")
N TMP S TMP=0 F S TMP=$O(@TIULQ@("TEXT",TMP)) Q:'+TMP!('+CONT) D
. N X
. S CONT=$$CONTINUE() Q:'+CONT
. S X=@TIULQ@("TEXT",TMP,0) S:X="" X=" " W X,!
I '+CONT S TIUCONT=0
Q:'+CONT
D HFCPNT("CLS")
FFTR D HFCPNT("FTR")
Q
ADDENDA ; print addenda
S TIULQ=$NA(^TMP("TIULQ",$J,TIUDA,"ZADD"))
S TMP=0 F S TMP=$O(@TIULQ@(TMP)) Q:'+TMP!('+CONT) D
. W @IOF ; start each addenda on new page
. W $$DATE^TIULS(@TIULQ@(TMP,1301,"I"),"MM/DD/CCYY HR:MIN")," ","ADDENDUM",?40,"STATUS: ",@TIULQ@(TMP,.05,"E"),!
. W "AUTHOR: ",$E(@TIULQ@(TMP,1202,"E"),1,30),?40,"EXPECTED COSIGNER: ",$E(@TIULQ@(TMP,1208,"E"),1,20),!
. N TIUI S TIUI=0 F S TIUI=$O(@TIULQ@(TMP,"TEXT",TIUI)) Q:'+TIUI!('+CONT) D
. . N X
. . S CONT=$$CONTINUE Q:'+CONT
. . S X=@TIULQ@(TMP,"TEXT",TIUI,0) S:X="" X=" " W X,!
. Q:'+CONT
. D FFTR ; print final footer
. S TIUISADD=1
Q
GUIVIEW(TIUDA,SEG,TIUL,TIUARR) ;
N DFN,NODE,ROOT,TIUD9,TIUA,TIUI,TIUJ,TIUTYP,TIUX,TIUY,X
S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2),TIUTYP=+$G(^TIU(8925,TIUDA,0))
I $G(TIUL)'>0 S TIUL=0
I $P($G(^TIU(8925.1,+$G(TIUTYP),0)),U)["ADDENDUM",+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
F D Q:+TIUI!('+TIUTYP)
. S TIUI=+$O(^TIU(8925.95,"B",TIUTYP,0)) I +TIUI Q
. S TIUTYP=$O(^TIU(8925.1,"AD",TIUTYP,0))
I '+TIUI Q
S TIUD9=$G(^TIU(8925.95,+TIUI,9))
F NODE=6,7,8 S ROOT=$NA(^TIU(8925.95,+TIUI,NODE)) D
. S TIUJ=$S(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
. K ^TMP("TIUBOIL",$J)
. D BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
. M TIUX(TIUJ)=^TMP("TIUBOIL",$J)
. K ^TMP("TIUBOIL",$J)
. S TIUY=$P(TIUD9,U,(NODE-5)) I +$L(TIUY) S TIUA=0 F S TIUA=$O(TIUX(TIUJ,TIUA)) Q:'+TIUA S TIUX(TIUJ,TIUA,0)=$S(TIUY="CJ":$$CENTER^TIULS(TIUX(TIUJ,TIUA,0)),TIUY="RJ":$$SPACER(TIUX(TIUJ,TIUA,0),IOM,1),1:TIUX(TIUJ,TIUA,0))
S TIUI=0 F S TIUI=$O(TIUX(SEG,TIUI)) Q:'+TIUI S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUX(SEG,TIUI,0)
F TIUI=1:1:+$P(TIUD9,U,6) S TIUL=TIUL+1,@TIUARR@(TIUL)=" "
Q
SETUP(TIUTYP,TIUDA) ;
N DFN,TIUDAD,TIUI,TIUJ,TIUY
S (TIUD9,TIUPN)="" I '+$G(TIUDA) Q
I '+$G(TIUTYP),+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,TIUDA,0))
S DFN=$P(^TIU(8925,TIUDA,0),U,2)
I $P($G(^TIU(8925.1,+$G(TIUTYP),0)),U)["ADDENDUM",+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,+$P($G(^TIU(8925,+TIUDA,0)),U,6),0))
S TIUI=+$O(^TIU(8925.95,"B",TIUTYP,0)) I +TIUI D Q
. N NODE,ROOT
. S TIUD9=$G(^TIU(8925.95,+TIUI,9)),TIUPN=$P(TIUD9,U,4),TIUPNL=$P(TIUD9,U,5)
. F NODE=6,7,8 S ROOT=$NA(^TIU(8925.95,+TIUI,NODE)) D
. . S TIUJ=$S(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
. . K ^TMP("TIUBOIL",$J)
. . D BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
. . M TIU(TIUJ)=^TMP("TIUBOIL",$J)
. . K ^TMP("TIUBOIL",$J)
. . S TIUY=$P(TIUD9,U,(NODE-5)) I +$L(TIUY) N TIUX S TIUX=0 F S TIUX=$O(TIU(TIUJ,TIUX)) Q:'+TIUX S TIU(TIUJ,TIUX,0)=$S(TIUY="CJ":$$CENTER^TIULS(TIU(TIUJ,TIUX,0)),TIUY="RJ":$$SPACER(TIU(TIUJ,TIUX,0),IOM,1),1:TIU(TIUJ,TIUX,0))
S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0)) I +TIUDAD D SETUP(TIUDAD,TIUDA)
Q
SPACER(TEXT,LENGTH,REV) ;
N SPACER S SPACER=""
S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
S:'$D(REV) TEXT=TEXT_SPACER
S:$D(REV) TEXT=SPACER_TEXT
Q TEXT
STOP() ;
N DIR,Y,TIUCONT S DIR(0)="E" W ! D ^DIR S TIUCONT=Y
Q TIUCONT
TIUFLP1 ;SLC/AJB - TIU FORM LETTER PRINT; 06 MAR 07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**222**;Jun 20, 1997
+2 QUIT
PRINT ; main entry point
+1 NEW CONT,NDOC,TIUDA,TIUI,TIUJ,TIUPR
+2 SET CONT=1
SET NDOC=0
SET (TIUI,TIUJ)=""
+3 SET TIUPR=$NAME(^TMP("TIUPR",$JOB))
+4 FOR
SET TIUI=$ORDER(@TIUPR@(TIUI))
IF TIUI=""
QUIT
Begin DoDot:1
+5 FOR
SET TIUJ=$ORDER(@TIUPR@(TIUI,TIUJ))
IF TIUJ=""
QUIT
Begin DoDot:2
+6 SET TIUDA=""
FOR
SET TIUDA=$ORDER(@TIUPR@(TIUI,TIUJ,TIUDA))
IF '+TIUDA
QUIT
Begin DoDot:3
+7 SET NDOC=NDOC+1
IF NDOC>1
WRITE @IOF
+8 NEW DFN,NOL,PAGE,PAGES,TIU,TIUD9,TIUERR,TIUISADD,TIULQ,TIUPN,TIUPNL,TIUTYP,TIUY
+9 IF '$DATA(^TIU(8925,+TIUDA,0))
Begin DoDot:4
+10 WRITE !,"Document #",TIUDA," no longer exists in the TIU DOCUMENT file.",!
+11 SET CONT=$$STOP
End DoDot:4
QUIT
+12 SET DFN=$PIECE(^TIU(8925,TIUDA,0),U,2)
SET PAGE=1
SET PAGES=""
+13 SET TIULQ=$NAME(^TMP("TIULQ",$JOB))
KILL @TIULQ
DO EXTRACT^TIULQ(+TIUDA,TIULQ,.TIUERR,"","",1)
+14 IF +$GET(TIUERR)
WRITE !,$PIECE(TIUERR,U,2),!
SET CONT=$$STOP
QUIT
+15 SET TIULQ=$NAME(^TMP("TIULQ",$JOB,TIUDA))
+16 SET TIUTYP=+$GET(^TIU(8925,+TIUDA,0))
+17 DO SETUP(TIUTYP,TIUDA)
+18 DO PAGES
+19 DO REPORT
IF '+CONT
QUIT
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:4
+20 FOR
IF $Y'<(IOSL-NOL("FTR")-$SELECT(+TIUPN
QUIT
WRITE !
End DoDot:4
SET CONT=$$STOP
+21 DO ADDENDA
IF '+CONT
QUIT
IF +$GET(TIUISADD)
IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:4
+22 FOR
IF $Y'<(IOSL-NOL("FTR")-$SELECT(+TIUPN
QUIT
WRITE !
End DoDot:4
SET CONT=$$STOP
End DoDot:3
IF '+CONT
QUIT
End DoDot:2
IF '+CONT
QUIT
End DoDot:1
IF '+CONT
QUIT
+23 QUIT
CONTINUE() ; controls paging
+1 IF $EXTRACT(IOST,1,2)="C-"
IF $Y<(IOSL-NOL("FTR")-2)
GOTO CONTY
Begin DoDot:1
+2 DO HFCPNT("FTR")
End DoDot:1
SET CONT=$$STOP
GOTO CONTX
+3 IF $Y<(IOSL-NOL("FTR"))
GOTO CONTY
+4 IF IOSL<250
FOR
IF $Y'<(IOSL-NOL("FTR"))
QUIT
WRITE !
+5 DO HFCPNT("FTR")
IF $EXTRACT(IOST,1,2)="C-"
SET CONT=$$STOP
CONTX IF +CONT
WRITE @IOF
CONTY QUIT CONT
IDKID(TIUDA,KIDDA) ; print ID children note
+1 NEW KNUM,NODE,NOL,PAGE,PAGES,TIU,TIULQ,TIUTYP
+2 SET PAGE=1
SET PAGES=""
SET TIULQ=$NAME(^TMP("TIULQ",$JOB,TIUDA))
SET TIUTYP=+$GET(^TIU(8925,+KIDDA,0))
+3 DO SETUP(TIUTYP,KIDDA)
+4 DO IDPAGES
+5 SET KNUM=NOL(KIDDA)
SET TIULQ=$NAME(^TMP("TIULQ",$JOB,TIUDA,"ZZID",KNUM,KIDDA))
+6 WRITE @IOF
+7 DO REPORT
+8 QUIT
IDPAGES ; calculates # of pages for ID child note
+1 NEW IDK,ISKID,TIUX
+2 ; # of lines in parent document
SET NOL=""
SET NOL=$ORDER(@TIULQ@("TEXT",NOL),-1)
SET NOL("PARENT")=NOL
+3 ; # of lines ID child
SET IDK=0
FOR
SET IDK=$ORDER(@TIULQ@("ZZID",IDK))
IF '+IDK
QUIT
SET NOL=""
SET NOL=$ORDER(@TIULQ@("ZZID",IDK,KIDDA,"TEXT",NOL),-1)
IF +NOL
SET NOL(KIDDA)=IDK
SET NOL("IDK",KIDDA)=(NOL-NOL("PARENT"))
+4 DO IDK
+5 ; add # of lines in ID child body,heading,closing
SET NOL("IDK",KIDDA)=NOL("IDK",KIDDA)+NOL("HDR")+NOL("CLS")
+6 ; calculate # of pages for ID child
SET PAGES=NOL("IDK",KIDDA)\(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
IF +NOL("IDK",KIDDA)#(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
SET PAGES=PAGES+1
+7 QUIT
HFCPNT(NODE) ; heading,footer,closing print (page numbers optional)
+1 NEW TIUI
SET TIUI=0
FOR
SET TIUI=$ORDER(TIU(NODE,TIUI))
IF TIUI=""!('+CONT)
QUIT
Begin DoDot:1
+2 IF NODE="HDR"
WRITE TIU(NODE,TIUI,0),!
QUIT
+3 IF NODE="CLS"
Begin DoDot:2
+4 IF $Y<(IOSL-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0)-$SELECT(+TIUPN:2,1:0))
WRITE TIU(NODE,TIUI,0),!
+5 IF '$TEST
Begin DoDot:3
+6 IF +TIUPN
SET TIUY="Page "_PAGE_" of "_PAGES
SET TIUY=$SELECT(TIUPNL="CJ":$$CENTER^TIULS(TIUY),TIUPNL="RJ":$$SPACER(TIUY,IOM,1),1:TIUY)
WRITE !,TIUY
SET PAGE=PAGE+1
SET TIUI=TIUI-1
End DoDot:3
IF $EXTRACT(IOST,1,2)="C-"
SET CONT=$$STOP
WRITE @IOF
End DoDot:2
QUIT
+7 IF IOSL<250
FOR
IF $Y'<(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-"
QUIT
WRITE !
+8 WRITE TIU(NODE,TIUI,0),!
End DoDot:1
+9 IF '+CONT
QUIT
+10 IF NODE="FTR"
IF +TIUPN
SET TIUY="Page "_PAGE_" of "_PAGES
SET TIUY=$SELECT(TIUPNL="CJ":$$CENTER^TIULS(TIUY),TIUPNL="RJ":$$SPACER(TIUY,IOM,1),1:TIUY)
WRITE TIUY
SET PAGE=PAGE+1
+11 QUIT
PAGES ; calculates total # of pages
+1 NEW ADD,TIUX
+2 ; # of lines in parent document
SET NOL=""
SET NOL=$ORDER(@TIULQ@("TEXT",NOL),-1)
SET NOL("PARENT")=NOL
+3 ; # of lines in each addendum
SET ADD=""
FOR
SET ADD=$ORDER(@TIULQ@("ZADD",ADD))
IF '+ADD
QUIT
SET NOL=""
SET NOL=$ORDER(@TIULQ@("ZADD",ADD,"TEXT",NOL),-1)
SET NOL("ADD",ADD)=(NOL-NOL("PARENT"))
IDK ; # of lines in heading,footer & closing
FOR NOL="HDR","FTR","CLS"
SET ADD=""
SET NOL(NOL)=$ORDER(TIU(NOL,ADD),-1)
+1 ; adds one blank line in header & # of lines desired by user
IF +NOL("HDR")
SET TIU("HDR",(NOL("HDR")+1),0)=" "
SET NOL("HDR")=NOL("HDR")+1
FOR TIUX=1:1:+$PIECE(TIUD9,U,6)
SET NOL("HDR")=NOL("HDR")+1
SET TIU("HDR",NOL("HDR"),0)=" "
+2 ; if no header, add # of lines desired by user
IF '+NOL("HDR")
FOR TIUX=1:1:+$PIECE(TIUD9,U,6)
SET TIU("HDR",TIUX,0)=" "
SET NOL("HDR")=TIUX
+3 ; add blank line to beginning of footer & closing
FOR NOL="FTR","CLS"
IF +NOL(NOL)
Begin DoDot:1
+4 NEW TMP
SET TMP=0
FOR
SET TMP=$ORDER(TIU(NOL,TMP))
IF '+TMP
QUIT
SET TMP(NOL,(TMP+1),0)=TIU(NOL,TMP,0)
+5 SET TMP(NOL,1,0)=" "
MERGE TIU(NOL)=TMP(NOL)
+6 SET NOL(NOL)=NOL(NOL)+1
End DoDot:1
+7 ; if pages numbers, add one line to # of lines in the footer
IF +NOL("FTR")
IF +TIUPN
SET NOL("FTR")=NOL("FTR")+1
+8 ; if no footer and pages numbers, add one line to footer
IF '+NOL("FTR")
IF +TIUPN
SET NOL("FTR")=1
+9 IF +$GET(ISKID)
QUIT
+10 ; add # of lines in parent,heading & closing
SET NOL("PARENT")=NOL("PARENT")+NOL("HDR")+NOL("CLS")
+11 ; calculate # of pages for parent
SET PAGES=NOL("PARENT")\(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
IF +NOL("PARENT")#(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
SET PAGES=PAGES+1
+12 ; calculate # of pages for addenda (one page minimum per)
SET ADD=""
FOR
SET ADD=$ORDER(NOL("ADD",ADD))
IF '+ADD
QUIT
Begin DoDot:1
+13 NEW ADPAGES
SET ADPAGES=NOL("ADD",ADD)\(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
IF +NOL("ADD",ADD)#(IOSL-NOL("FTR")-$SELECT($EXTRACT(IOST,1,2)="C-":2,1:0))
SET ADPAGES=ADPAGES+1
+14 SET PAGES=PAGES+ADPAGES
End DoDot:1
+15 QUIT
REPORT ; print parent note
+1 IF PAGE=1
DO HFCPNT("HDR")
+2 NEW TMP
SET TMP=0
FOR
SET TMP=$ORDER(@TIULQ@("TEXT",TMP))
IF '+TMP!('+CONT)
QUIT
Begin DoDot:1
+3 NEW X
+4 SET CONT=$$CONTINUE()
IF '+CONT
QUIT
+5 SET X=@TIULQ@("TEXT",TMP,0)
IF X=""
SET X=" "
WRITE X,!
End DoDot:1
+6 IF '+CONT
SET TIUCONT=0
+7 IF '+CONT
QUIT
+8 DO HFCPNT("CLS")
FFTR DO HFCPNT("FTR")
+1 QUIT
ADDENDA ; print addenda
+1 SET TIULQ=$NAME(^TMP("TIULQ",$JOB,TIUDA,"ZADD"))
+2 SET TMP=0
FOR
SET TMP=$ORDER(@TIULQ@(TMP))
IF '+TMP!('+CONT)
QUIT
Begin DoDot:1
+3 ; start each addenda on new page
WRITE @IOF
+4 WRITE $$DATE^TIULS(@TIULQ@(TMP,1301,"I"),"MM/DD/CCYY HR:MIN")," ","ADDENDUM",?40,"STATUS: ",@TIULQ@(TMP,.05,"E"),!
+5 WRITE "AUTHOR: ",$EXTRACT(@TIULQ@(TMP,1202,"E"),1,30),?40,"EXPECTED COSIGNER: ",$EXTRACT(@TIULQ@(TMP,1208,"E"),1,20),!
+6 NEW TIUI
SET TIUI=0
FOR
SET TIUI=$ORDER(@TIULQ@(TMP,"TEXT",TIUI))
IF '+TIUI!('+CONT)
QUIT
Begin DoDot:2
+7 NEW X
+8 SET CONT=$$CONTINUE
IF '+CONT
QUIT
+9 SET X=@TIULQ@(TMP,"TEXT",TIUI,0)
IF X=""
SET X=" "
WRITE X,!
End DoDot:2
+10 IF '+CONT
QUIT
+11 ; print final footer
DO FFTR
+12 SET TIUISADD=1
End DoDot:1
+13 QUIT
GUIVIEW(TIUDA,SEG,TIUL,TIUARR) ;
+1 NEW DFN,NODE,ROOT,TIUD9,TIUA,TIUI,TIUJ,TIUTYP,TIUX,TIUY,X
+2 SET DFN=$PIECE($GET(^TIU(8925,TIUDA,0)),U,2)
SET TIUTYP=+$GET(^TIU(8925,TIUDA,0))
+3 IF $GET(TIUL)'>0
SET TIUL=0
+4 IF $PIECE($GET(^TIU(8925.1,+$GET(TIUTYP),0)),U)["ADDENDUM"
IF +$GET(TIUDA)
SET TIUTYP=+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0))
+5 FOR
Begin DoDot:1
+6 SET TIUI=+$ORDER(^TIU(8925.95,"B",TIUTYP,0))
IF +TIUI
QUIT
+7 SET TIUTYP=$ORDER(^TIU(8925.1,"AD",TIUTYP,0))
End DoDot:1
IF +TIUI!('+TIUTYP)
QUIT
+8 IF '+TIUI
QUIT
+9 SET TIUD9=$GET(^TIU(8925.95,+TIUI,9))
+10 FOR NODE=6,7,8
SET ROOT=$NAME(^TIU(8925.95,+TIUI,NODE))
Begin DoDot:1
+11 SET TIUJ=$SELECT(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
+12 KILL ^TMP("TIUBOIL",$JOB)
+13 DO BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
+14 MERGE TIUX(TIUJ)=^TMP("TIUBOIL",$JOB)
+15 KILL ^TMP("TIUBOIL",$JOB)
+16 SET TIUY=$PIECE(TIUD9,U,(NODE-5))
IF +$LENGTH(TIUY)
SET TIUA=0
FOR
SET TIUA=$ORDER(TIUX(TIUJ,TIUA))
IF '+TIUA
QUIT
SET TIUX(TIUJ,TIUA,0)=$SELECT(TIUY="CJ":$$CENTER^TIULS(TIUX(TIUJ,TIUA,0)),TIUY="RJ":$$SPACER(TIUX(TIUJ,TIUA,0),IOM,1),1:TIUX(TIUJ,TIUA,0))
End DoDot:1
+17 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUX(SEG,TIUI))
IF '+TIUI
QUIT
SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=TIUX(SEG,TIUI,0)
+18 FOR TIUI=1:1:+$PIECE(TIUD9,U,6)
SET TIUL=TIUL+1
SET @TIUARR@(TIUL)=" "
+19 QUIT
SETUP(TIUTYP,TIUDA) ;
+1 NEW DFN,TIUDAD,TIUI,TIUJ,TIUY
+2 SET (TIUD9,TIUPN)=""
IF '+$GET(TIUDA)
QUIT
+3 IF '+$GET(TIUTYP)
IF +$GET(TIUDA)
SET TIUTYP=+$GET(^TIU(8925,TIUDA,0))
+4 SET DFN=$PIECE(^TIU(8925,TIUDA,0),U,2)
+5 IF $PIECE($GET(^TIU(8925.1,+$GET(TIUTYP),0)),U)["ADDENDUM"
IF +$GET(TIUDA)
SET TIUTYP=+$GET(^TIU(8925,+$PIECE($GET(^TIU(8925,+TIUDA,0)),U,6),0))
+6 SET TIUI=+$ORDER(^TIU(8925.95,"B",TIUTYP,0))
IF +TIUI
Begin DoDot:1
+7 NEW NODE,ROOT
+8 SET TIUD9=$GET(^TIU(8925.95,+TIUI,9))
SET TIUPN=$PIECE(TIUD9,U,4)
SET TIUPNL=$PIECE(TIUD9,U,5)
+9 FOR NODE=6,7,8
SET ROOT=$NAME(^TIU(8925.95,+TIUI,NODE))
Begin DoDot:2
+10 SET TIUJ=$SELECT(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
+11 KILL ^TMP("TIUBOIL",$JOB)
+12 DO BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
+13 MERGE TIU(TIUJ)=^TMP("TIUBOIL",$JOB)
+14 KILL ^TMP("TIUBOIL",$JOB)
+15 SET TIUY=$PIECE(TIUD9,U,(NODE-5))
IF +$LENGTH(TIUY)
NEW TIUX
SET TIUX=0
FOR
SET TIUX=$ORDER(TIU(TIUJ,TIUX))
IF '+TIUX
QUIT
SET TIU(TIUJ,TIUX,0)=$SELECT(TIUY="CJ":$$CENTER^TIULS(TIU(TIUJ,TIUX,0)),TIUY="RJ":$$SPACER(TIU(TIUJ,TIUX,0),IOM,1),1:TIU(TIUJ,TIUX,0))
End DoDot:2
End DoDot:1
QUIT
+16 SET TIUDAD=$ORDER(^TIU(8925.1,"AD",+TIUTYP,0))
IF +TIUDAD
DO SETUP(TIUDAD,TIUDA)
+17 QUIT
SPACER(TEXT,LENGTH,REV) ;
+1 NEW SPACER
SET SPACER=""
+2 SET $PIECE(SPACER," ",(LENGTH-$LENGTH(TEXT)))=" "
+3 IF '$DATA(REV)
SET TEXT=TEXT_SPACER
+4 IF $DATA(REV)
SET TEXT=SPACER_TEXT
+5 QUIT TEXT
STOP() ;
+1 NEW DIR,Y,TIUCONT
SET DIR(0)="E"
WRITE !
DO ^DIR
SET TIUCONT=Y
+2 QUIT TIUCONT
