Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIUFLP1

TIUFLP1.m

Go to the documentation of this file. 
  1. TIUFLP1 ;SLC/AJB - TIU FORM LETTER PRINT; 06 MAR 07
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**222**;Jun 20, 1997
  1.  Q
  1. PRINT ; main entry point
  1.  N CONT,NDOC,TIUDA,TIUI,TIUJ,TIUPR
  1.  S CONT=1,NDOC=0,(TIUI,TIUJ)=""
  1.  S TIUPR=$NA(^TMP("TIUPR",$J))
  1.  F  S TIUI=$O(@TIUPR@(TIUI)) Q:TIUI=""  D  Q:'+CONT
  1.  . F  S TIUJ=$O(@TIUPR@(TIUI,TIUJ)) Q:TIUJ=""  D  Q:'+CONT
  1.  . . S TIUDA="" F  S TIUDA=$O(@TIUPR@(TIUI,TIUJ,TIUDA)) Q:'+TIUDA  D  Q:'+CONT
  1.  . . . S NDOC=NDOC+1 I NDOC>1 W @IOF
  1.  . . . N DFN,NOL,PAGE,PAGES,TIU,TIUD9,TIUERR,TIUISADD,TIULQ,TIUPN,TIUPNL,TIUTYP,TIUY
  1.  . . . I '$D(^TIU(8925,+TIUDA,0)) D  Q
  1.  . . . . W !,"Document #",TIUDA," no longer exists in the TIU DOCUMENT file.",!
  1.  . . . . S CONT=$$STOP
  1.  . . . S DFN=$P(^TIU(8925,TIUDA,0),U,2),PAGE=1,PAGES=""
  1.  . . . S TIULQ=$NA(^TMP("TIULQ",$J)) K @TIULQ D EXTRACT^TIULQ(+TIUDA,TIULQ,.TIUERR,"","",1)
  1.  . . . I +$G(TIUERR) W !,$P(TIUERR,U,2),! S CONT=$$STOP Q
  1.  . . . S TIULQ=$NA(^TMP("TIULQ",$J,TIUDA))
  1.  . . . S TIUTYP=+$G(^TIU(8925,+TIUDA,0))
  1.  . . . D SETUP(TIUTYP,TIUDA)
  1.  . . . D PAGES
  1.  . . . D REPORT Q:'+CONT  I $E(IOST,1,2)="C-" D  S CONT=$$STOP
  1.  . . . . F  Q:$Y'<(IOSL-NOL("FTR")-$S(+TIUPN:1,1:0)-3)  W !
  1.  . . . D ADDENDA Q:'+CONT  I +$G(TIUISADD),$E(IOST,1,2)="C-" D  S CONT=$$STOP
  1.  . . . . F  Q:$Y'<(IOSL-NOL("FTR")-$S(+TIUPN:1,1:0)-3)  W !
  1.  Q
  1. CONTINUE() ; controls paging
  1.  I $E(IOST,1,2)="C-" G CONTY:$Y<(IOSL-NOL("FTR")-2) D  S CONT=$$STOP G CONTX
  1.  . D HFCPNT("FTR")
  1.  G:$Y<(IOSL-NOL("FTR")) CONTY
  1.  I IOSL<250 F  Q:$Y'<(IOSL-NOL("FTR"))  W !
  1.  D HFCPNT("FTR") S:$E(IOST,1,2)="C-" CONT=$$STOP
  1. CONTX I +CONT W @IOF
  1. CONTY Q CONT
  1. IDKID(TIUDA,KIDDA) ; print ID children note
  1.  N KNUM,NODE,NOL,PAGE,PAGES,TIU,TIULQ,TIUTYP
  1.  S PAGE=1,PAGES="",TIULQ=$NA(^TMP("TIULQ",$J,TIUDA)),TIUTYP=+$G(^TIU(8925,+KIDDA,0))
  1.  D SETUP(TIUTYP,KIDDA)
  1.  D IDPAGES
  1.  S KNUM=NOL(KIDDA),TIULQ=$NA(^TMP("TIULQ",$J,TIUDA,"ZZID",KNUM,KIDDA))
  1.  W @IOF
  1.  D REPORT
  1.  Q
  1. IDPAGES ; calculates # of pages for ID child note
  1.  N IDK,ISKID,TIUX
  1.  S NOL="",NOL=$O(@TIULQ@("TEXT",NOL),-1),NOL("PARENT")=NOL ; # of lines in parent document
  1.  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
  1.  D IDK
  1.  S NOL("IDK",KIDDA)=NOL("IDK",KIDDA)+NOL("HDR")+NOL("CLS") ; add # of lines in ID child body,heading,closing
  1.  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
  1.  Q
  1. HFCPNT(NODE) ; heading,footer,closing print (page numbers optional)
  1.  N TIUI S TIUI=0 F  S TIUI=$O(TIU(NODE,TIUI)) Q:TIUI=""!('+CONT)  D
  1.  . I NODE="HDR" W TIU(NODE,TIUI,0),! Q
  1.  . I NODE="CLS" D  Q
  1.  . . I $Y<(IOSL-$S($E(IOST,1,2)="C-":2,1:0)-$S(+TIUPN:2,1:0)) W TIU(NODE,TIUI,0),!
  1.  . . E  D  S:$E(IOST,1,2)="C-" CONT=$$STOP W @IOF
  1.  . . . 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
  1.  . I IOSL<250 F  Q:$Y'<(IOSL-NOL("FTR")-$S($E(IOST,1,2)="C-":2,1:0))  W !
  1.  . W TIU(NODE,TIUI,0),!
  1.  Q:'+CONT
  1.  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
  1.  Q
  1. PAGES ; calculates total # of pages
  1.  N ADD,TIUX
  1.  S NOL="",NOL=$O(@TIULQ@("TEXT",NOL),-1),NOL("PARENT")=NOL ; # of lines in parent document
  1.  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
  1. IDK F NOL="HDR","FTR","CLS" S ADD="",NOL(NOL)=$O(TIU(NOL,ADD),-1) ; # of lines in heading,footer & closing
  1.  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
  1.  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
  1.  F NOL="FTR","CLS" I +NOL(NOL) D  ; add blank line to beginning of footer & closing
  1.  . N TMP S TMP=0 F  S TMP=$O(TIU(NOL,TMP)) Q:'+TMP  S TMP(NOL,(TMP+1),0)=TIU(NOL,TMP,0)
  1.  . S TMP(NOL,1,0)=" " M TIU(NOL)=TMP(NOL)
  1.  . S NOL(NOL)=NOL(NOL)+1
  1.  I +NOL("FTR"),+TIUPN S NOL("FTR")=NOL("FTR")+1 ; if pages numbers, add one line to # of lines in the footer
  1.  I '+NOL("FTR"),+TIUPN S NOL("FTR")=1 ; if no footer and pages numbers, add one line to footer
  1.  I +$G(ISKID) Q
  1.  S NOL("PARENT")=NOL("PARENT")+NOL("HDR")+NOL("CLS") ; add # of lines in parent,heading & closing
  1.  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
  1.  S ADD="" F  S ADD=$O(NOL("ADD",ADD)) Q:'+ADD  D  ; calculate # of pages for addenda (one page minimum per)
  1.  . 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
  1.  . S PAGES=PAGES+ADPAGES
  1.  Q
  1. REPORT ; print parent note
  1.  I PAGE=1 D HFCPNT("HDR")
  1.  N TMP S TMP=0 F  S TMP=$O(@TIULQ@("TEXT",TMP)) Q:'+TMP!('+CONT)  D
  1.  . N X
  1.  . S CONT=$$CONTINUE() Q:'+CONT
  1.  . S X=@TIULQ@("TEXT",TMP,0) S:X="" X=" " W X,!
  1.  I '+CONT S TIUCONT=0
  1.  Q:'+CONT
  1.  D HFCPNT("CLS")
  1. FFTR D HFCPNT("FTR")
  1.  Q
  1. ADDENDA ; print addenda
  1.  S TIULQ=$NA(^TMP("TIULQ",$J,TIUDA,"ZADD"))
  1.  S TMP=0 F  S TMP=$O(@TIULQ@(TMP)) Q:'+TMP!('+CONT)  D
  1.  . W @IOF ; start each addenda on new page
  1.  . W $$DATE^TIULS(@TIULQ@(TMP,1301,"I"),"MM/DD/CCYY HR:MIN")," ","ADDENDUM",?40,"STATUS:  ",@TIULQ@(TMP,.05,"E"),!
  1.  . W "AUTHOR: ",$E(@TIULQ@(TMP,1202,"E"),1,30),?40,"EXPECTED COSIGNER: ",$E(@TIULQ@(TMP,1208,"E"),1,20),!
  1.  . N TIUI S TIUI=0 F  S TIUI=$O(@TIULQ@(TMP,"TEXT",TIUI)) Q:'+TIUI!('+CONT)  D
  1.  . . N X
  1.  . . S CONT=$$CONTINUE Q:'+CONT
  1.  . . S X=@TIULQ@(TMP,"TEXT",TIUI,0) S:X="" X=" " W X,!
  1.  . Q:'+CONT
  1.  . D FFTR ; print final footer
  1.  . S TIUISADD=1
  1.  Q
  1. GUIVIEW(TIUDA,SEG,TIUL,TIUARR) ;
  1.  N DFN,NODE,ROOT,TIUD9,TIUA,TIUI,TIUJ,TIUTYP,TIUX,TIUY,X
  1.  S DFN=$P($G(^TIU(8925,TIUDA,0)),U,2),TIUTYP=+$G(^TIU(8925,TIUDA,0))
  1.  I $G(TIUL)'>0 S TIUL=0
  1.  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))
  1.  F  D  Q:+TIUI!('+TIUTYP)
  1.  . S TIUI=+$O(^TIU(8925.95,"B",TIUTYP,0)) I +TIUI Q
  1.  . S TIUTYP=$O(^TIU(8925.1,"AD",TIUTYP,0))
  1.  I '+TIUI Q
  1.  S TIUD9=$G(^TIU(8925.95,+TIUI,9))
  1.  F NODE=6,7,8 S ROOT=$NA(^TIU(8925.95,+TIUI,NODE)) D
  1.  . S TIUJ=$S(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
  1.  . K ^TMP("TIUBOIL",$J)
  1.  . D BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
  1.  . M TIUX(TIUJ)=^TMP("TIUBOIL",$J)
  1.  . K ^TMP("TIUBOIL",$J)
  1.  . 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))
  1.  S TIUI=0 F  S TIUI=$O(TIUX(SEG,TIUI)) Q:'+TIUI  S TIUL=TIUL+1,@TIUARR@(TIUL)=TIUX(SEG,TIUI,0)
  1.  F TIUI=1:1:+$P(TIUD9,U,6) S TIUL=TIUL+1,@TIUARR@(TIUL)=" "
  1.  Q
  1. SETUP(TIUTYP,TIUDA) ;
  1.  N DFN,TIUDAD,TIUI,TIUJ,TIUY
  1.  S (TIUD9,TIUPN)="" I '+$G(TIUDA) Q
  1.  I '+$G(TIUTYP),+$G(TIUDA) S TIUTYP=+$G(^TIU(8925,TIUDA,0))
  1.  S DFN=$P(^TIU(8925,TIUDA,0),U,2)
  1.  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))
  1.  S TIUI=+$O(^TIU(8925.95,"B",TIUTYP,0)) I +TIUI D  Q
  1.  . N NODE,ROOT
  1.  . S TIUD9=$G(^TIU(8925.95,+TIUI,9)),TIUPN=$P(TIUD9,U,4),TIUPNL=$P(TIUD9,U,5)
  1.  . F NODE=6,7,8 S ROOT=$NA(^TIU(8925.95,+TIUI,NODE)) D
  1.  . . S TIUJ=$S(NODE=6:"HDR",NODE=7:"FTR",1:"CLS")
  1.  . . K ^TMP("TIUBOIL",$J)
  1.  . . D BLRPLT^TIUSRVD(.TIUY,"",DFN,"",ROOT)
  1.  . . M TIU(TIUJ)=^TMP("TIUBOIL",$J)
  1.  . . K ^TMP("TIUBOIL",$J)
  1.  . . 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))
  1.  S TIUDAD=$O(^TIU(8925.1,"AD",+TIUTYP,0)) I +TIUDAD D SETUP(TIUDAD,TIUDA)
  1.  Q
  1. SPACER(TEXT,LENGTH,REV) ;
  1.  N SPACER S SPACER=""
  1.  S $P(SPACER," ",(LENGTH-$L(TEXT)))=" "
  1.  S:'$D(REV) TEXT=TEXT_SPACER
  1.  S:$D(REV) TEXT=SPACER_TEXT
  1.  Q TEXT
  1. STOP() ;
  1.  N DIR,Y,TIUCONT S DIR(0)="E" W ! D ^DIR S TIUCONT=Y
  1.  Q TIUCONT