source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRDS1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.1 KB
Line 
1TIUPRDS1 ; SLC/SBW,JER - Print DS Form 10-1000 ;8/15/06 11:01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**55,52,162,211**;Jun 20, 1997;Build 26
3PRINT(TIUDA,TIUFLAG) ; Print Summary
4 ; TIUCONT=1 for Continue, 0 for Exit, NULL for Timeout.
5 ; Returned from $$Stop
6 N TIUADD,TIUPAGE,TIUCOPY,TIUSTAT,TIUCONT,TIUY,TIU,STDTTL
7 S TIUPAGE=1 D GETTIU^TIULD(.TIU,TIUDA)
8 I +$G(TIU("LDT")),+$G(TIU("AD#")) D I 1
9 . N DGPMIFN S DGPMIFN=+$G(TIU("AD#")) D ^DGPMLOS S TIU("DAYS")=X
10 E S TIU("WARD")=""
11 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")
12 E S TIUSTAT=$$STATUS^TIULC(TIUDA),TIUCOPY=$S(TIUSTAT="completed":"C O P Y",1:"D R A F T")
13 W:$E(IOST,1,2)="C-" @IOF D HEADER^TIUPRDS2(TIUDA,.TIU,TIUFLAG,.TIUPAGE)
14 W !,"DICTATION DATE: ",$P(^TMP("TIULQ",$J,TIUDA,1307,"E"),"@"),?40,"TRANSCRIPTION DATE: ",$P(^TMP("TIULQ",$J,TIUDA,1201,"E"),"@")
15 W !,"LOCAL TITLE: ",$G(^TMP("TIULQ",$J,TIUDA,.01,"E"))
16 S STDTTL=$G(^TMP("TIULQ",$J,TIUDA,89261,"E"))
17 I $L(STDTTL)>1 W !,"STANDARD TITLE: ",STDTTL
18 W !,"TRANSCRIPTIONIST: ",^TMP("TIULQ",$J,TIUDA,1302,"E")
19 W:$E(IOST,1,2)'="C-" !!
20REPORT ; Report Text
21 N DIW,DIWF,DIWL,DIWR,DIWT,TIUI,X,Z K ^UTILITY($J,"W")
22 S TIUI=0,TIUCONT=1,TIUY=6,DIWF="WN",DIWL=1,DIWR=79
23 F S TIUI=$O(^TMP("TIULQ",$J,TIUDA,"TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT
24 . D SETCONT() Q:'TIUCONT
25 . S X=^TMP("TIULQ",$J,TIUDA,"TEXT",TIUI,0) S:X="" X=" " D ^DIWP
26 D ^DIWW K ^UTILITY($J,"W")
27 Q:'TIUCONT
28AMENDMNT ;If DCS has been amended, next lines are printed.
29 S TIUY=9 D SETCONT() Q:'TIUCONT
30 I +$G(^TMP("TIULQ",$J,TIUDA,1601,"I")) D
31 . W !!,^TMP("TIULQ",$J,TIUDA,1601,"E"),?23,"AMENDMENT FILED:"
32 . I $G(^TMP("TIULQ",$J,TIUDA,1603,"E"))']"" W !!?23 F TIUI=1:1:40 W "_"
33 . I $G(^TMP("TIULQ",$J,TIUDA,1604,"E"))]"" D
34 . . W !?17,"/es/",?23,^TMP("TIULQ",$J,TIUDA,1604,"E")
35 . . W !?23,$G(^TMP("TIULQ",$J,TIUDA,1605,"E"))
36RPTSIG ; Signature should be on bottom of form, Addenda on Subsequent pages
37 N TIULINE,TIUSBLK,EXPSGNR,ATTNDNG
38 S EXPSGNR=+$G(^TMP("TIULQ",$J,TIUDA,1204,"I"))
39 S ATTNDNG=+$G(^TMP("TIULQ",$J,TIUDA,1209,"I"))
40 D LOADSIG^TIULS1(.TIUSBLK,$NA(^TMP("TIULQ",$J,TIUDA)))
41 S $P(TIULINE,"-",IOM)=""
42 S TIUY=TIUSBLK+8 D SETCONT() Q:'TIUCONT
43 I (IOT'="HFS")!(IOSL<250) F Q:$Y+TIUY>IOSL W ! ;move SIG to pg Bottom
44 I +$G(TIUFLAG) W !,TIULINE
45 E W !,"WORK COPY =========== UNOFFICIAL - NOT FOR MEDICAL RECORD ========== DO NOT FILE"
46 I EXPSGNR'=ATTNDNG W !,"SIGNATURE PHYSICIAN/DENTIST",?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
47 E W !?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
48 W ! S TIUI=0 F S TIUI=$O(TIUSBLK(TIUI)) Q:+TIUI'>0 W !,TIUSBLK(TIUI)
49 I +$G(TIUFLAG) W !,TIULINE
50 E W !,"=========================== CONFIDENTIAL INFORMATION ==========================="
51ADDENDA ; Discharge Summary Addenda
52 N DIW,DIWF,DIWL,DIWR,DIWT,X,Z K ^UTILITY($J,"W")
53 S TIUADD=0,DIWF="WN",DIWL=1,DIWR=79
54 F S TIUADD=$O(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD)) Q:TIUADD'>0 D Q:'TIUCONT
55 . S TIUY=6 D SETCONT() Q:'TIUCONT
56 . W !!,$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1201,"E")),?23,"ADDENDUM" ;P162
57 . W ?39,"STATUS: ",$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,.05,"E")) ;P162
58 . S TIUI=0
59 . F S TIUI=$O(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,"TEXT",TIUI)) Q:TIUI'>0 D Q:'TIUCONT
60 . . D SETCONT() Q:'TIUCONT
61 . . S X=^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,"TEXT",TIUI,0) S:X="" X=" " D ^DIWP
62 . D ^DIWW
63 . D:TIUCONT ADDENSIG
64 ; Next line moves footer to bottom of page/screen
65 I TIUCONT,((IOT'="HFS")!(IOSL<250)) S TIUY=6 F Q:$Y+TIUY>IOSL W !
66 I D SETCONT(1)
67 K ^UTILITY($J,"W")
68 Q
69ADDENSIG ;
70 N TIUSBLK,EXPSGNR,ATTNDNG
71 D LOADSIG^TIULS1(.TIUSBLK,$NA(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD)))
72 S $P(TIULINE,"-",80)=""
73 S EXPSGNR=$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1204,"I"))
74 S ATTNDNG=$G(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD,1209,"I"))
75 S TIUY=12 D SETCONT() Q:'TIUCONT
76 I EXPSGNR'=ATTNDNG W !,"SIGNATURE PHYSICIAN/DENTIST",?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
77 E W !?39,"SIGNATURE APPROVING PHYSICIAN/DENTIST"
78 W ! S TIUI=0 F S TIUI=$O(TIUSBLK(TIUI)) Q:+TIUI'>0 W !,TIUSBLK(TIUI)
79 Q
80SETCONT(TIUHEAD) ;Does footer and sets TIUCONT
81 S TIUCONT=$$FOOTER^TIUPRDS2(TIUDA,.TIU,TIUFLAG,.TIUPAGE,TIUCOPY,$G(TIUHEAD))
82 Q
Note: See TracBrowser for help on using the repository browser.