83 lines
4.1 KiB
Mathematica
83 lines
4.1 KiB
Mathematica
TIUPRDS1 ; SLC/SBW,JER - Print DS Form 10-1000 ;8/15/06 11:01
|
|
;;1.0;TEXT INTEGRATION UTILITIES;**55,52,162,211**;Jun 20, 1997;Build 26
|
|
PRINT(TIUDA,TIUFLAG) ; Print Summary
|
|
; TIUCONT=1 for Continue, 0 for Exit, NULL for Timeout.
|
|
; Returned from $$Stop
|
|
N TIUADD,TIUPAGE,TIUCOPY,TIUSTAT,TIUCONT,TIUY,TIU,STDTTL
|
|
S TIUPAGE=1 D GETTIU^TIULD(.TIU,TIUDA)
|
|
I +$G(TIU("LDT")),+$G(TIU("AD#")) D I 1
|
|
. N DGPMIFN S DGPMIFN=+$G(TIU("AD#")) D ^DGPMLOS S TIU("DAYS")=X
|
|
E S TIU("WARD")=""
|
|
I $E(IOST,1,2)="P-",+$G(TIUFLAG) S TIUCOPY=$S(+TIUFLAG=2:"ELECTRONICALLY SIGNED CHART COPY",1:"C H A R T C O P Y")
|
|
E S TIUSTAT=$$STATUS^TIULC(TIUDA),TIUCOPY=$S(TIUSTAT="completed":"C O P Y",1:"D R A F T")
|
|
W:$E(IOST,1,2)="C-" @IOF D HEADER^TIUPRDS2(TIUDA,.TIU,TIUFLAG,.TIUPAGE)
|
|
W !,"DICTATION DATE: ",$P(^TMP("TIULQ",$J,TIUDA,1307,"E"),"@"),?40,"TRANSCRIPTION DATE: ",$P(^TMP("TIULQ",$J,TIUDA,1201,"E"),"@")
|
|
W !,"LOCAL TITLE: ",$G(^TMP("TIULQ",$J,TIUDA,.01,"E"))
|
|
S STDTTL=$G(^TMP("TIULQ",$J,TIUDA,89261,"E"))
|
|
I $L(STDTTL)>1 W !,"STANDARD TITLE: ",STDTTL
|
|
W !,"TRANSCRIPTIONIST: ",^TMP("TIULQ",$J,TIUDA,1302,"E")
|
|
W:$E(IOST,1,2)'="C-" !!
|
|
REPORT ; Report Text
|
|
N DIW,DIWF,DIWL,DIWR,DIWT,TIUI,X,Z K ^UTILITY($J,"W")
|
|
S TIUI=0,TIUCONT=1,TIUY=6,DIWF="WN",DIWL=1,DIWR=79
|
|
F S TIUI=$O(^TMP("TIULQ",$J,TIUDA,"TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT
|
|
. D SETCONT() Q:'TIUCONT
|
|
. S X=^TMP("TIULQ",$J,TIUDA,"TEXT",TIUI,0) S:X="" X=" " D ^DIWP
|
|
D ^DIWW K ^UTILITY($J,"W")
|
|
Q:'TIUCONT
|
|
AMENDMNT ;If DCS has been amended, next lines are printed.
|
|
S TIUY=9 D SETCONT() Q:'TIUCONT
|
|
I +$G(^TMP("TIULQ",$J,TIUDA,1601,"I")) D
|
|
. W !!,^TMP("TIULQ",$J,TIUDA,1601,"E"),?23,"AMENDMENT FILED:"
|
|
. I $G(^TMP("TIULQ",$J,TIUDA,1603,"E"))']"" W !!?23 F TIUI=1:1:40 W "_"
|
|
. I $G(^TMP("TIULQ",$J,TIUDA,1604,"E"))]"" D
|
|
. . W !?17,"/es/",?23,^TMP("TIULQ",$J,TIUDA,1604,"E")
|
|
. . W !?23,$G(^TMP("TIULQ",$J,TIUDA,1605,"E"))
|
|
RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages
|
|
N TIULINE,TIUSBLK,EXPSGNR,ATTNDNG
|
|
S EXPSGNR=+$G(^TMP("TIULQ",$J,TIUDA,1204,"I"))
|
|
S ATTNDNG=+$G(^TMP("TIULQ",$J,TIUDA,1209,"I"))
|
|
D LOADSIG^TIULS1(.TIUSBLK,$NA(^TMP("TIULQ",$J,TIUDA)))
|
|
S $P(TIULINE,"-",IOM)=""
|
|
S TIUY=TIUSBLK+8 D SETCONT() Q:'TIUCONT
|
|
I (IOT'="HFS")!(IOSL<250) F Q:$Y+TIUY>IOSL W ! ;move SIG to pg Bottom
|
|
I +$G(TIUFLAG) W !,TIULINE
|
|
E W !,"WORK COPY =========== UNOFFICIAL - NOT FOR MEDICAL RECORD ========== DO NOT FILE"
|
|
I EXPSGNR'=ATTNDNG W !,"SIGNATURE PHYSICIAN/DENTIST",?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
|
|
E W !?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
|
|
W ! S TIUI=0 F S TIUI=$O(TIUSBLK(TIUI)) Q:+TIUI'>0 W !,TIUSBLK(TIUI)
|
|
I +$G(TIUFLAG) W !,TIULINE
|
|
E W !,"=========================== CONFIDENTIAL INFORMATION ==========================="
|
|
ADDENDA ; Discharge Summary Addenda
|
|
N DIW,DIWF,DIWL,DIWR,DIWT,X,Z K ^UTILITY($J,"W")
|
|
S TIUADD=0,DIWF="WN",DIWL=1,DIWR=79
|
|
F S TIUADD=$O(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD)) Q:TIUADD'>0 D Q:'TIUCONT
|
|
. S TIUY=6 D SETCONT() Q:'TIUCONT
|
|
. W !!,$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1201,"E")),?23,"ADDENDUM" ;P162
|
|
. W ?39,"STATUS: ",$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,.05,"E")) ;P162
|
|
. S TIUI=0
|
|
. F S TIUI=$O(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,"TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT
|
|
. . D SETCONT() Q:'TIUCONT
|
|
. . S X=^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,"TEXT",TIUI,0) S:X="" X=" " D ^DIWP
|
|
. D ^DIWW
|
|
. D:TIUCONT ADDENSIG
|
|
; Next line moves footer to bottom of page/screen
|
|
I TIUCONT,((IOT'="HFS")!(IOSL<250)) S TIUY=6 F Q:$Y+TIUY>IOSL W !
|
|
I D SETCONT(1)
|
|
K ^UTILITY($J,"W")
|
|
Q
|
|
ADDENSIG ;
|
|
N TIUSBLK,EXPSGNR,ATTNDNG
|
|
D LOADSIG^TIULS1(.TIUSBLK,$NA(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD)))
|
|
S $P(TIULINE,"-",80)=""
|
|
S EXPSGNR=$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1204,"I"))
|
|
S ATTNDNG=$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1209,"I"))
|
|
S TIUY=12 D SETCONT() Q:'TIUCONT
|
|
I EXPSGNR'=ATTNDNG W !,"SIGNATURE PHYSICIAN/DENTIST",?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
|
|
E W !?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
|
|
W ! S TIUI=0 F S TIUI=$O(TIUSBLK(TIUI)) Q:+TIUI'>0 W !,TIUSBLK(TIUI)
|
|
Q
|
|
SETCONT(TIUHEAD) ;Does footer and sets TIUCONT
|
|
S TIUCONT=$$FOOTER^TIUPRDS2(TIUDA,.TIU,TIUFLAG,.TIUPAGE,TIUCOPY,$G(TIUHEAD))
|
|
Q
|