TIUPRPN1 ;SLC/JER - Print SF 509-Progress Notes ;11/23/07
;;1.0;TEXT INTEGRATION UTILITIES;**45,52,87,100,162,182,211,222,234,233**;Jun 20, 1997;Build 3
;
; EXTERNAL REFERENCE - DBIA 10040 ^SC(D0,0)
;
PRINT(TIUFLAG,TIUSPG) ; Print Document
; ^TMP("TIUPR",$J) is array of records to be printed
; TIUFLAG=1 --> Chart Copy TIUSPG=1 --> Contiguous
; TIUFLAG=0 --> Work Copy TIUSPG=0 --> Fresh Page- each note
; TIUCONT=1 --> Continue printing
; TIUCONT1=1 --> Write "Continue to next/from previous-page" msgs
; TIUPFNBR ---> Print Form # like vice 509
; TIUMISC=TIUFLAG_U_TIUPFNBR_U_TIUDA
N CONT,TIUASK,TIUI,TIUJ,TIUKID,TIUPAGE,TIUFOOT,TIUK,TIUDA,TIUCONT,TIUPGRP,TIUTYP
N TIUPFHDR,TIUPFNBR,TIUMISC,TIUCONT1,TIUIDONE,TMP
S TIUFLAG=+$G(TIUFLAG),TIUSPG=+$G(TIUSPG)
S (CONT,TIUCONT)=1,(TIUASK,TIUCONT1)=0
S TIUI=0 F S TIUI=$O(^TMP("TIUPR",$J,TIUI)) Q:TIUI="" D Q:'TIUCONT
. N DFN,TIU
. ; -- P182 TIUI has form PGRP$PFHDR;DFN with PGRP possibly 0, and
. ; PFHDR possibly null (see TIURA):
. S TIUPGRP=+$P(TIUI,"$"),TIUPFHDR=$P($P(TIUI,";"),"$",2)
. I TIUPFHDR']"" S TIUPFHDR="Progress Notes"
. S DFN=$P(TIUI,";",2)
. I $G(TIUPGRP)>2 S TIUSPG=0
. D PATPN^TIULV(.TIUFOOT,DFN)
. I +$G(TIUSPG) D HEADER^TIUPRPN2(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1)
. ; Use TIUJ="" (not TIUJ=0), to print "complete" notes w/o sigdt:
. S TIUJ="" F S TIUJ=$O(^TMP("TIUPR",$J,TIUI,TIUJ)) Q:TIUJ="" D Q:'TIUCONT
. . S TIUK=0 F S TIUK=$O(^TMP("TIUPR",$J,TIUI,TIUJ,TIUK)) Q:'TIUK D Q:'TIUCONT
. . . S TIUCONT1=0 S TIUPFNBR=^TMP("TIUPR",$J,TIUI,TIUJ,TIUK)
. . . ; Note: TIUPFNBR may be null
. . . ;P182 Set TIUMISC BEFORE quitting if deleted
. . . S TIUDA=TIUK,TIUMISC=TIUFLAG_U_TIUPFNBR_U_TIUDA
. . . ; Quit docmt if deleted:
. . . I '$D(^TIU(8925,+TIUDA,0)) D Q
. . . . S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
. . . . W !!,"NOTE DATED:",!,"Document #",TIUDA," for ",$G(TIUFOOT("PNMP")),!,"no longer exists in the TIU DOCUMENT file.",!!!
. . . . S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT))
. . . N TIUROOT
. . . I '+$G(TIUSPG) D HEADER^TIUPRPN2(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1)
. . . K ^TMP("TIULQ",$J)
. . . D EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1)
. . . I +$G(TIUERR) W !,$P(TIUERR,U,2) Q
. . . Q:'$D(^TMP("TIULQ",$J))
. . . S TIUROOT="^TMP(""TIULQ"",$J,"_TIUDA_")"
. . . D REPORT(TIUROOT,.TIUFOOT,TIUMISC,.TIUCONT) Q:'TIUCONT
. . . D IDKIDS(TIUROOT,.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT) Q:'TIUCONT
. . . I '+$G(TIUKID),'+$G(TIUSPG) S TIUCONT1=0 S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$G(TIUROOT))
. Q:'TIUCONT
. I $E(IOST,1,2)="C-" S TIUCONT=$$STOP^TIUPRPN2() Q:'TIUCONT
. I '+$G(TIUKID),+$G(TIUSPG),$E(IOST,1,2)'="C-" S TIUCONT1=0 S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$G(TIUROOT))
Q
;
REPORT(TIUROOT,TIUFOOT,TIUMISC,TIUCONT,TIUIDEND) ; Report Text
; Requires array TIUFOOT, vars TIUMISC, TIUCONT
; Requires TIUROOT =
; ^TMP("TIULQ",$J,NOTEIFN) for parent/stand-alone note, or
; ^TMP("TIULQ",$J,NOTEIFN,"ZADD",ADDMIFN) for addendum, or
; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",KIDSEQ#,IDKIDIFN) for ID kid, or
; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",KIDSEQ#,IDKIDIFN,"ZADD",KIDADDMIFN)
; for ID kid addm.
N DIW,DIWF,DIWL,DIWR,DIWT,TIUERR,TIU,TIUI,X,Z,LOC
N REFDT,TITLE,LOINCNM,ADT,HLOC,SUBJ
N TIUDA,TIUCONT1,HASIDKID,HASIDDAD
S TIUDA=$P(TIUMISC,U,3),TIUCONT1=0
S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
S HASIDKID=$G(^TMP("TIULQ",$J,TIUDA,"ZZID",0)) ;how many ID kids
S HASIDDAD=$S(TIUROOT["ZZID":1,1:0)
I HASIDKID W "<< Interdisciplinary Note - Begin >>",!
I HASIDDAD W "<< Interdisciplinary Note - Cont. >>",!
W $S('HASIDKID&'HASIDDAD:"NOTE DATED: ",1:"ENTRY DATED: ")
S REFDT=@TIUROOT@(1301,"I")
W $$DATE^TIULS(REFDT,"MM/DD/CCYY HR:MIN")
S TITLE=@TIUROOT@(.01,"E"),LOINCNM=@TIUROOT@(89261,"E")
W !,"LOCAL TITLE: ",$$UP^XLFSTR(TITLE),!
I $L(LOINCNM)>1 W "STANDARD TITLE: ",$$UP^XLFSTR(LOINCNM),!
S LOC=$G(@TIUROOT@(1205,"I"))
I +LOC D
. W $S($P(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ")
. S ADT=$G(@TIUROOT@(.07,"I"))
. W $$DATE^TIULS(ADT,"MM/DD/CCYY HR:MIN")
. S HLOC=$G(@TIUROOT@(1205,"E"))
. W " ",HLOC
S SUBJ=$G(@TIUROOT@(1701,"E"))
I SUBJ]"" W !,"SUBJECT: ",^("E"),! ; @TIUROOT@(1701,"E")
S TIUCONT1=1
I $D(@TIUROOT@("PROBLEM")) D Q:'TIUCONT
. S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
. W !,"ASSOCIATED PROBLEMS:"
. N TIUI S TIUI=0
. F S TIUI=$O(@TIUROOT@("PROBLEM",TIUI)) Q:'TIUI D Q:'TIUCONT
..W !,^(TIUI,0) ; @TIUROOT@("PROBLEM",TIUI,0)
..S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
W !
S TIUI=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
F S TIUI=$O(@TIUROOT@("TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT ; D ^DIWW
. S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
. S X=@TIUROOT@("TEXT",TIUI,0) S:X="" X=" " D ^DIWP
D ^DIWW K ^UTILITY($J,"W")
Q:'TIUCONT
D GETSIG(TIUROOT,.TIUSIG)
S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
W !
D SIGBLK^TIUPRPN8(.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT,.TIUSIG,TIUROOT)
Q:'TIUCONT
ADDENDA ; Fall through and do Addenda of docmt TIUDA
N DIW,DIWF,DIWL,DIWR,DIWT,X,Z,TIUI,TIUADD,ADDMRDT
S TIUADD=0,DIWF="WN",DIWL=1,DIWR=79 K ^UTILITY($J,"W")
; VM/RJT - *233 - quit if addendum status is unreleased (=3)
F S TIUADD=$O(@TIUROOT@("ZADD",TIUADD)) Q:TIUADD'>0 Q:$P($G(^TIU(8925,TIUADD,0)),U,5)=3 D Q:'TIUCONT
. S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
. S ADDMRDT=@TIUROOT@("ZADD",TIUADD,1301,"I")
. W !!,$$DATE^TIULS(ADDMRDT,"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM"
. W ?39,"STATUS: ",@TIUROOT@("ZADD",TIUADD,.05,"E") ;P162
. S TIUI=0
. F S TIUI=$O(@TIUROOT@("ZADD",TIUADD,"TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT
. . S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
. . S X=@TIUROOT@("ZADD",TIUADD,"TEXT",TIUI,0) S:X="" X=" " D ^DIWP
. D ^DIWW
. Q:'TIUCONT
. N TIUADRT
. S TIUADRT=$P(TIUROOT,")")_",""ZADD"","_TIUADD_")"
. D GETSIG(TIUADRT,.TIUSIG)
. D SIGBLK^TIUPRPN8(.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT,.TIUSIG,TIUADRT)
; Need ! in front for amended notes:
I $G(TIUIDEND) W !,"<< Interdisciplinary Note - End >>",!
K ^UTILITY($J,"W")
; Write 2 linefeeds between records
S:$E(IOST,1,2)="C-" TIUCONT=$$STOP^TIUFLP1,TIUASK=1
W:TIUCONT !!
Q
;
IDKIDS(TIUROOT,TIUFOOT,TIUMISC,TIUCONT1,TIUCONT) ; Print ID kids
;of docmt TIUDA (each kid does its own addenda)
N TIUL,KIDDA,TIUDA,TIUSORT,TIUIDRT,TIUIDEND
S TIUDA=$P(TIUMISC,U,3),TIUIDEND=0
S TIUL=0
F S TIUL=$O(^TMP("TIULQ",$J,TIUDA,"ZZID",TIUL)) Q:'TIUL D Q:'TIUCONT
. S KIDDA=$O(^TMP("TIULQ",$J,TIUDA,"ZZID",TIUL,0))
. I +$$MEMBEROF^TIUPR222(+$G(^TIU(8925,+KIDDA,0)),"FORM LETTERS") D Q ; hand off to TIUFLP1 (Form Letter Print)
. . I '+$G(TIUKID),'+$G(TIUSPG) S TIUCONT1=0 S TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$G(TIUROOT))
. . I 'TIUCONT!'CONT Q
. . I $E(IOST,1,2)="C-",'+TIUASK S CONT=$$STOP^TIUFLP1,TIUCONT=CONT Q:'+CONT
. . S TIUASK=0,TIUKID=1 D IDKID^TIUFLP1(TIUDA,KIDDA)
. S TIUMISC=TIUFLAG_U_TIUPFNBR_U_KIDDA
. S TIUIDRT="^TMP(""TIULQ"",$J,"_TIUDA_",""ZZID"","_TIUL_","_KIDDA_")"
. I '$O(^TMP("TIULQ",$J,TIUDA,"ZZID",TIUL)) S TIUIDEND=1
. D REPORT(TIUIDRT,.TIUFOOT,TIUMISC,.TIUCONT,TIUIDEND)
Q
;
GETSIG(TIUROOT,TIUSIG) ; Get signature info from TIULQ global;
; Set info into TIUSIG array **100**
; Requires array name TIUROOT; passes back array TIUSIG
; TIUROOT = ^TMP("TIULQ",$J,NOTEIFN) for parent note, or
; ^TMP("TIULQ",$J,NOTEIFN,"ZADD",ADDMIFN) for addendum, or
; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",IDKIDIFN) for ID kid.
; Signature should be on bottom of form, Addenda on Subsequent pages
N TIULINE S $P(TIULINE,"-",81)=""
S TIUSIG("AUTHOR")=$G(@TIUROOT@(1202,"I"))_";"_$G(^("E"))
S TIUSIG("EXPSIGNR")=$G(@TIUROOT@(1204,"I"))_";"_$G(^("E"))
S TIUSIG("EXPCOSNR")=$G(@TIUROOT@(1208,"I"))_";"_$G(^("E"))
S TIUSIG("SIGNDATE")=$G(@TIUROOT@(1501,"I"))
S TIUSIG("SIGNEDBY")=$G(@TIUROOT@(1502,"I"))_";"_$G(^("E"))
S TIUSIG("SIGNNAME")=$G(@TIUROOT@(1503,"E"))
S TIUSIG("SIGTITL")=$G(@TIUROOT@(1504,"E"))
S TIUSIG("SIGNMODE")=$G(@TIUROOT@(1505,"I"))_";"_$G(^("E"))
S TIUSIG("COSGDATE")=$G(@TIUROOT@(1507,"I"))
S TIUSIG("COSGEDBY")=$G(@TIUROOT@(1508,"I"))_";"_$G(^("E"))
S TIUSIG("COSGNAME")=$G(@TIUROOT@(1509,"E"))
S TIUSIG("COSGTITL")=$G(@TIUROOT@(1510,"E"))
S TIUSIG("COSGMODE")=$G(@TIUROOT@(1511,"I"))_";"_$G(^("E"))
S TIUSIG("SIGCHRT")=$G(@TIUROOT@(1512,"I"))_";"_$G(^("E"))
S TIUSIG("COSCHRT")=$G(@TIUROOT@(1513,"I"))_";"_$G(^("E"))
; -- P182 Set Admin Clos Date:
S TIUSIG("ADMINCDT")=$G(@TIUROOT@(1606,"I"))_";"_$G(^("E"))
Q
;
SETCONT(TIUFOOT,TIUMISC,TIUCONT1,TIUHEAD,TIUROOT) ;Does footer
;and returns TIUCONT
; Requires array TIUFOOT, vars TIUMISC,TIUCONT1; optional TIUHEAD
; Optional TIUROOT
Q $$FOOTER^TIUPRPN2(.TIUFOOT,TIUMISC,TIUCONT1,TIUHEAD,$G(TIUROOT))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPRPN1 9114 printed Dec 13, 2024@02:43:46 Page 2
TIUPRPN1 ;SLC/JER - Print SF 509-Progress Notes ;11/23/07
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**45,52,87,100,162,182,211,222,234,233**;Jun 20, 1997;Build 3
+2 ;
+3 ; EXTERNAL REFERENCE - DBIA 10040 ^SC(D0,0)
+4 ;
PRINT(TIUFLAG,TIUSPG) ; Print Document
+1 ; ^TMP("TIUPR",$J) is array of records to be printed
+2 ; TIUFLAG=1 --> Chart Copy TIUSPG=1 --> Contiguous
+3 ; TIUFLAG=0 --> Work Copy TIUSPG=0 --> Fresh Page- each note
+4 ; TIUCONT=1 --> Continue printing
+5 ; TIUCONT1=1 --> Write "Continue to next/from previous-page" msgs
+6 ; TIUPFNBR ---> Print Form # like vice 509
+7 ; TIUMISC=TIUFLAG_U_TIUPFNBR_U_TIUDA
+8 NEW CONT,TIUASK,TIUI,TIUJ,TIUKID,TIUPAGE,TIUFOOT,TIUK,TIUDA,TIUCONT,TIUPGRP,TIUTYP
+9 NEW TIUPFHDR,TIUPFNBR,TIUMISC,TIUCONT1,TIUIDONE,TMP
+10 SET TIUFLAG=+$GET(TIUFLAG)
SET TIUSPG=+$GET(TIUSPG)
+11 SET (CONT,TIUCONT)=1
SET (TIUASK,TIUCONT1)=0
+12 SET TIUI=0
FOR
SET TIUI=$ORDER(^TMP("TIUPR",$JOB,TIUI))
if TIUI=""
QUIT
Begin DoDot:1
+13 NEW DFN,TIU
+14 ; -- P182 TIUI has form PGRP$PFHDR;DFN with PGRP possibly 0, and
+15 ; PFHDR possibly null (see TIURA):
+16 SET TIUPGRP=+$PIECE(TIUI,"$")
SET TIUPFHDR=$PIECE($PIECE(TIUI,";"),"$",2)
+17 IF TIUPFHDR']""
SET TIUPFHDR="Progress Notes"
+18 SET DFN=$PIECE(TIUI,";",2)
+19 IF $GET(TIUPGRP)>2
SET TIUSPG=0
+20 DO PATPN^TIULV(.TIUFOOT,DFN)
+21 IF +$GET(TIUSPG)
DO HEADER^TIUPRPN2(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1)
+22 ; Use TIUJ="" (not TIUJ=0), to print "complete" notes w/o sigdt:
+23 SET TIUJ=""
FOR
SET TIUJ=$ORDER(^TMP("TIUPR",$JOB,TIUI,TIUJ))
if TIUJ=""
QUIT
Begin DoDot:2
+24 SET TIUK=0
FOR
SET TIUK=$ORDER(^TMP("TIUPR",$JOB,TIUI,TIUJ,TIUK))
if 'TIUK
QUIT
Begin DoDot:3
+25 SET TIUCONT1=0
SET TIUPFNBR=^TMP("TIUPR",$JOB,TIUI,TIUJ,TIUK)
+26 ; Note: TIUPFNBR may be null
+27 ;P182 Set TIUMISC BEFORE quitting if deleted
+28 SET TIUDA=TIUK
SET TIUMISC=TIUFLAG_U_TIUPFNBR_U_TIUDA
+29 ; Quit docmt if deleted:
+30 IF '$DATA(^TIU(8925,+TIUDA,0))
Begin DoDot:4
+31 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+32 WRITE !!,"NOTE DATED:",!,"Document #",TIUDA," for ",$GET(TIUFOOT("PNMP")),!,"no longer exists in the TIU DOCUMENT file.",!!!
+33 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
End DoDot:4
QUIT
+34 NEW TIUROOT
+35 IF '+$GET(TIUSPG)
DO HEADER^TIUPRPN2(.TIUFOOT,TIUFLAG,.TIUPFHDR,TIUCONT1)
+36 KILL ^TMP("TIULQ",$JOB)
+37 DO EXTRACT^TIULQ(+TIUDA,"^TMP(""TIULQ"",$J)",.TIUERR,"","",1)
+38 IF +$GET(TIUERR)
WRITE !,$PIECE(TIUERR,U,2)
QUIT
+39 if '$DATA(^TMP("TIULQ",$JOB))
QUIT
+40 SET TIUROOT="^TMP(""TIULQ"",$J,"_TIUDA_")"
+41 DO REPORT(TIUROOT,.TIUFOOT,TIUMISC,.TIUCONT)
if 'TIUCONT
QUIT
+42 DO IDKIDS(TIUROOT,.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT)
if 'TIUCONT
QUIT
+43 IF '+$GET(TIUKID)
IF '+$GET(TIUSPG)
SET TIUCONT1=0
SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$GET(TIUROOT))
End DoDot:3
if 'TIUCONT
QUIT
End DoDot:2
if 'TIUCONT
QUIT
+44 if 'TIUCONT
QUIT
+45 IF $EXTRACT(IOST,1,2)="C-"
SET TIUCONT=$$STOP^TIUPRPN2()
if 'TIUCONT
QUIT
+46 IF '+$GET(TIUKID)
IF +$GET(TIUSPG)
IF $EXTRACT(IOST,1,2)'="C-"
SET TIUCONT1=0
SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$GET(TIUROOT))
End DoDot:1
if 'TIUCONT
QUIT
+47 QUIT
+48 ;
REPORT(TIUROOT,TIUFOOT,TIUMISC,TIUCONT,TIUIDEND) ; Report Text
+1 ; Requires array TIUFOOT, vars TIUMISC, TIUCONT
+2 ; Requires TIUROOT =
+3 ; ^TMP("TIULQ",$J,NOTEIFN) for parent/stand-alone note, or
+4 ; ^TMP("TIULQ",$J,NOTEIFN,"ZADD",ADDMIFN) for addendum, or
+5 ; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",KIDSEQ#,IDKIDIFN) for ID kid, or
+6 ; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",KIDSEQ#,IDKIDIFN,"ZADD",KIDADDMIFN)
+7 ; for ID kid addm.
+8 NEW DIW,DIWF,DIWL,DIWR,DIWT,TIUERR,TIU,TIUI,X,Z,LOC
+9 NEW REFDT,TITLE,LOINCNM,ADT,HLOC,SUBJ
+10 NEW TIUDA,TIUCONT1,HASIDKID,HASIDDAD
+11 SET TIUDA=$PIECE(TIUMISC,U,3)
SET TIUCONT1=0
+12 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+13 ;how many ID kids
SET HASIDKID=$GET(^TMP("TIULQ",$JOB,TIUDA,"ZZID",0))
+14 SET HASIDDAD=$SELECT(TIUROOT["ZZID":1,1:0)
+15 IF HASIDKID
WRITE "<< Interdisciplinary Note - Begin >>",!
+16 IF HASIDDAD
WRITE "<< Interdisciplinary Note - Cont. >>",!
+17 WRITE $SELECT('HASIDKID&'HASIDDAD:"NOTE DATED: ",1:"ENTRY DATED: ")
+18 SET REFDT=@TIUROOT@(1301,"I")
+19 WRITE $$DATE^TIULS(REFDT,"MM/DD/CCYY HR:MIN")
+20 SET TITLE=@TIUROOT@(.01,"E")
SET LOINCNM=@TIUROOT@(89261,"E")
+21 WRITE !,"LOCAL TITLE: ",$$UP^XLFSTR(TITLE),!
+22 IF $LENGTH(LOINCNM)>1
WRITE "STANDARD TITLE: ",$$UP^XLFSTR(LOINCNM),!
+23 SET LOC=$GET(@TIUROOT@(1205,"I"))
+24 IF +LOC
Begin DoDot:1
+25 WRITE $SELECT($PIECE(^SC(LOC,0),U,3)="W":"ADMITTED: ",1:"VISIT: ")
+26 SET ADT=$GET(@TIUROOT@(.07,"I"))
+27 WRITE $$DATE^TIULS(ADT,"MM/DD/CCYY HR:MIN")
+28 SET HLOC=$GET(@TIUROOT@(1205,"E"))
+29 WRITE " ",HLOC
End DoDot:1
+30 SET SUBJ=$GET(@TIUROOT@(1701,"E"))
+31 ; @TIUROOT@(1701,"E")
IF SUBJ]""
WRITE !,"SUBJECT: ",^("E"),!
+32 SET TIUCONT1=1
+33 IF $DATA(@TIUROOT@("PROBLEM"))
Begin DoDot:1
+34 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+35 WRITE !,"ASSOCIATED PROBLEMS:"
+36 NEW TIUI
SET TIUI=0
+37 FOR
SET TIUI=$ORDER(@TIUROOT@("PROBLEM",TIUI))
if 'TIUI
QUIT
Begin DoDot:2
+38 ; @TIUROOT@("PROBLEM",TIUI,0)
WRITE !,^(TIUI,0)
+39 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
End DoDot:2
if 'TIUCONT
QUIT
End DoDot:1
if 'TIUCONT
QUIT
+40 WRITE !
+41 SET TIUI=0
SET DIWF="WN"
SET DIWL=1
SET DIWR=79
KILL ^UTILITY($JOB,"W")
+42 ; D ^DIWW
FOR
SET TIUI=$ORDER(@TIUROOT@("TEXT",TIUI))
if TIUI'>0
QUIT
Begin DoDot:1
+43 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+44 SET X=@TIUROOT@("TEXT",TIUI,0)
if X=""
SET X=" "
DO ^DIWP
End DoDot:1
if 'TIUCONT
QUIT
+45 DO ^DIWW
KILL ^UTILITY($JOB,"W")
+46 if 'TIUCONT
QUIT
+47 DO GETSIG(TIUROOT,.TIUSIG)
+48 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+49 WRITE !
+50 DO SIGBLK^TIUPRPN8(.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT,.TIUSIG,TIUROOT)
+51 if 'TIUCONT
QUIT
ADDENDA ; Fall through and do Addenda of docmt TIUDA
+1 NEW DIW,DIWF,DIWL,DIWR,DIWT,X,Z,TIUI,TIUADD,ADDMRDT
+2 SET TIUADD=0
SET DIWF="WN"
SET DIWL=1
SET DIWR=79
KILL ^UTILITY($JOB,"W")
+3 ; VM/RJT - *233 - quit if addendum status is unreleased (=3)
+4 FOR
SET TIUADD=$ORDER(@TIUROOT@("ZADD",TIUADD))
if TIUADD'>0
QUIT
if $PIECE($GET(^TIU(8925,TIUADD,0)),U,5)=3
QUIT
Begin DoDot:1
+5 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+6 SET ADDMRDT=@TIUROOT@("ZADD",TIUADD,1301,"I")
+7 WRITE !!,$$DATE^TIULS(ADDMRDT,"MM/DD/CCYY HR:MIN"),?21,"ADDENDUM"
+8 ;P162
WRITE ?39,"STATUS: ",@TIUROOT@("ZADD",TIUADD,.05,"E")
+9 SET TIUI=0
+10 FOR
SET TIUI=$ORDER(@TIUROOT@("ZADD",TIUADD,"TEXT",TIUI))
if TIUI'>0
QUIT
Begin DoDot:2
+11 SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,0,$GET(TIUROOT))
if 'TIUCONT
QUIT
+12 SET X=@TIUROOT@("ZADD",TIUADD,"TEXT",TIUI,0)
if X=""
SET X=" "
DO ^DIWP
End DoDot:2
if 'TIUCONT
QUIT
+13 DO ^DIWW
+14 if 'TIUCONT
QUIT
+15 NEW TIUADRT
+16 SET TIUADRT=$PIECE(TIUROOT,")")_",""ZADD"","_TIUADD_")"
+17 DO GETSIG(TIUADRT,.TIUSIG)
+18 DO SIGBLK^TIUPRPN8(.TIUFOOT,TIUMISC,TIUCONT1,.TIUCONT,.TIUSIG,TIUADRT)
End DoDot:1
if 'TIUCONT
QUIT
+19 ; Need ! in front for amended notes:
+20 IF $GET(TIUIDEND)
WRITE !,"<< Interdisciplinary Note - End >>",!
+21 KILL ^UTILITY($JOB,"W")
+22 ; Write 2 linefeeds between records
+23 if $EXTRACT(IOST,1,2)="C-"
SET TIUCONT=$$STOP^TIUFLP1
SET TIUASK=1
+24 if TIUCONT
WRITE !!
+25 QUIT
+26 ;
IDKIDS(TIUROOT,TIUFOOT,TIUMISC,TIUCONT1,TIUCONT) ; Print ID kids
+1 ;of docmt TIUDA (each kid does its own addenda)
+2 NEW TIUL,KIDDA,TIUDA,TIUSORT,TIUIDRT,TIUIDEND
+3 SET TIUDA=$PIECE(TIUMISC,U,3)
SET TIUIDEND=0
+4 SET TIUL=0
+5 FOR
SET TIUL=$ORDER(^TMP("TIULQ",$JOB,TIUDA,"ZZID",TIUL))
if 'TIUL
QUIT
Begin DoDot:1
+6 SET KIDDA=$ORDER(^TMP("TIULQ",$JOB,TIUDA,"ZZID",TIUL,0))
+7 ; hand off to TIUFLP1 (Form Letter Print)
IF +$$MEMBEROF^TIUPR222(+$GET(^TIU(8925,+KIDDA,0)),"FORM LETTERS")
Begin DoDot:2
+8 IF '+$GET(TIUKID)
IF '+$GET(TIUSPG)
SET TIUCONT1=0
SET TIUCONT=$$SETCONT(.TIUFOOT,TIUMISC,TIUCONT1,1,$GET(TIUROOT))
+9 IF 'TIUCONT!'CONT
QUIT
+10 IF $EXTRACT(IOST,1,2)="C-"
IF '+TIUASK
SET CONT=$$STOP^TIUFLP1
SET TIUCONT=CONT
if '+CONT
QUIT
+11 SET TIUASK=0
SET TIUKID=1
DO IDKID^TIUFLP1(TIUDA,KIDDA)
End DoDot:2
QUIT
+12 SET TIUMISC=TIUFLAG_U_TIUPFNBR_U_KIDDA
+13 SET TIUIDRT="^TMP(""TIULQ"",$J,"_TIUDA_",""ZZID"","_TIUL_","_KIDDA_")"
+14 IF '$ORDER(^TMP("TIULQ",$JOB,TIUDA,"ZZID",TIUL))
SET TIUIDEND=1
+15 DO REPORT(TIUIDRT,.TIUFOOT,TIUMISC,.TIUCONT,TIUIDEND)
End DoDot:1
if 'TIUCONT
QUIT
+16 QUIT
+17 ;
GETSIG(TIUROOT,TIUSIG) ; Get signature info from TIULQ global;
+1 ; Set info into TIUSIG array **100**
+2 ; Requires array name TIUROOT; passes back array TIUSIG
+3 ; TIUROOT = ^TMP("TIULQ",$J,NOTEIFN) for parent note, or
+4 ; ^TMP("TIULQ",$J,NOTEIFN,"ZADD",ADDMIFN) for addendum, or
+5 ; ^TMP("TIULQ",$J,NOTEIFN,"ZZID",IDKIDIFN) for ID kid.
+6 ; Signature should be on bottom of form, Addenda on Subsequent pages
+7 NEW TIULINE
SET $PIECE(TIULINE,"-",81)=""
+8 SET TIUSIG("AUTHOR")=$GET(@TIUROOT@(1202,"I"))_";"_$GET(^("E"))
+9 SET TIUSIG("EXPSIGNR")=$GET(@TIUROOT@(1204,"I"))_";"_$GET(^("E"))
+10 SET TIUSIG("EXPCOSNR")=$GET(@TIUROOT@(1208,"I"))_";"_$GET(^("E"))
+11 SET TIUSIG("SIGNDATE")=$GET(@TIUROOT@(1501,"I"))
+12 SET TIUSIG("SIGNEDBY")=$GET(@TIUROOT@(1502,"I"))_";"_$GET(^("E"))
+13 SET TIUSIG("SIGNNAME")=$GET(@TIUROOT@(1503,"E"))
+14 SET TIUSIG("SIGTITL")=$GET(@TIUROOT@(1504,"E"))
+15 SET TIUSIG("SIGNMODE")=$GET(@TIUROOT@(1505,"I"))_";"_$GET(^("E"))
+16 SET TIUSIG("COSGDATE")=$GET(@TIUROOT@(1507,"I"))
+17 SET TIUSIG("COSGEDBY")=$GET(@TIUROOT@(1508,"I"))_";"_$GET(^("E"))
+18 SET TIUSIG("COSGNAME")=$GET(@TIUROOT@(1509,"E"))
+19 SET TIUSIG("COSGTITL")=$GET(@TIUROOT@(1510,"E"))
+20 SET TIUSIG("COSGMODE")=$GET(@TIUROOT@(1511,"I"))_";"_$GET(^("E"))
+21 SET TIUSIG("SIGCHRT")=$GET(@TIUROOT@(1512,"I"))_";"_$GET(^("E"))
+22 SET TIUSIG("COSCHRT")=$GET(@TIUROOT@(1513,"I"))_";"_$GET(^("E"))
+23 ; -- P182 Set Admin Clos Date:
+24 SET TIUSIG("ADMINCDT")=$GET(@TIUROOT@(1606,"I"))_";"_$GET(^("E"))
+25 QUIT
+26 ;
SETCONT(TIUFOOT,TIUMISC,TIUCONT1,TIUHEAD,TIUROOT) ;Does footer
+1 ;and returns TIUCONT
+2 ; Requires array TIUFOOT, vars TIUMISC,TIUCONT1; optional TIUHEAD
+3 ; Optional TIUROOT
+4 QUIT $$FOOTER^TIUPRPN2(.TIUFOOT,TIUMISC,TIUCONT1,TIUHEAD,$GET(TIUROOT))
