- 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 Feb 19, 2025@00:10:15 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))