source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRPN8.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.1 KB
Line 
1TIUPRPN8 ;SLC/MAM - Print SF 509-Progress Notes, Cont ;11/10/04 [1/4/05 12:17pm]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100,176,157,182,224**;Jun 20, 1997;Build 7
3 ;
4SIGBLK(TIUFOOT,TIUMISC,TIUCONT1,TIUCONT,TIUSIG,TIUROOT) ; Print signature block info
5 ; Requires array TIUFOOT, requires TIUMISC
6 ; Requires TIUCONT1
7 ; Receives TIUCONT by ref (req'd)
8 ; Receives array TIUSIG by ref, required.
9 ; Requires TIUROOT
10 N TIUDA,TIUFLAG
11 S TIUCONT=1,TIUDA=$P(TIUMISC,U,3),TIUFLAG=$P(TIUMISC,U)
12 ;S TIUGROOT=$NA(^TMP("TIULQ",$J,TIUDA))
13 ; -- P182 Don't marked admin signed notes as draft:
14 I '+TIUSIG("SIGNDATE"),'+TIUSIG("ADMINCDT") D Q:'TIUCONT
15 . W "**DRAFT COPY - DRAFT COPY -- ABOVE NOTE IS UNSIGNED--"
16 . W " DRAFT COPY - DRAFT COPY**",!
17 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT))
18 ;I TIUSIG("SIGNEDBY")]"",(+TIUSIG("SIGNEDBY")'=+TIUSIG("AUTHOR")) D
19 ;. W ?21,"Author: ",$P(TIUSIG("AUTHOR"),";",2),!
20 I +TIUSIG("SIGNDATE") D Q:'TIUCONT
21 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
22 . W ?18,"Signed by:",$S($P(TIUSIG("SIGNMODE"),";")="C":" /s/ ",1:" /es/ "),?34,$S(TIUSIG("SIGNNAME")]"":TIUSIG("SIGNNAME"),1:$P(TIUSIG("SIGNEDBY"),";",2))
23 . I $L(TIUSIG("SIGTITL"))>45 D
24 . . N TIUFT
25 . . D WRAP^TIUFLD(TIUSIG("SIGTITL"),45)
26 . . W !?34,$G(TIUFT(1))
27 . . W !?39,$G(TIUFT(2))
28 . I $L(TIUSIG("SIGTITL"))<46,TIUSIG("SIGTITL")]"" W !?34,TIUSIG("SIGTITL")
29 . W !?34,$$DATE^TIULS(+TIUSIG("SIGNDATE"),"MM/DD/CCYY HR:MIN")
30 . I '+$G(TIUFLAG)!($E(IOST)="C-") D
31 . . I $P($$BEEP^TIULC1(+TIUSIG("SIGNEDBY")),U) W !?34,"Analog Pager: ",$P($$BEEP^TIULC1(+TIUSIG("SIGNEDBY")),U)
32 . . I $P($$BEEP^TIULC1(+TIUSIG("SIGNEDBY")),U,2) W !?34,"Digital Pager: ",$P($$BEEP^TIULC1(+TIUSIG("SIGNEDBY")),U,2)
33 I $P(TIUSIG("SIGNMODE"),";")="C" D Q:'TIUCONT
34 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
35 . N TIUONCH
36 . S TIUONCH=$P(TIUSIG("SIGCHRT"),";",2)
37 . I TIUONCH']"" S TIUONCH=$P(TIUSIG("COSCHRT"),";",2)
38 . W !?2,"Marked signed on chart by:",?34,$G(TIUONCH)
39 ; -- If signer is not author, write "for the author":
40 ; P182 SIGNEDBY may =";" and follow null even when no signer:
41 ;I TIUSIG("SIGNEDBY")]"",(+TIUSIG("SIGNEDBY")'=+TIUSIG("AUTHOR")) D
42 I TIUSIG("SIGNEDBY")]"",(TIUSIG("SIGNEDBY")'=";"),(+TIUSIG("SIGNEDBY")'=+TIUSIG("AUTHOR")) D
43 . N TIUSIGTL
44 . W !?34,"for ",$P(TIUSIG("AUTHOR"),";",2)
45 . S TIUSIGTL=$$GET1^DIQ(200,$P(TIUSIG("AUTHOR"),";",1),20.3)
46 . I $D(TIUSIGTL) D
47 . . N TIUFT
48 . . D WRAP^TIUFLD(TIUSIGTL,45)
49 . . W !?34,$G(TIUFT(1))
50 . . W !?39,$G(TIUFT(2))
51 I $G(@TIUROOT@(.05,"E"))="UNCOSIGNED" D
52 . W !?34,"**REQUIRES COSIGNATURE**",!
53 ;I +$G(TIUADD) S TIUGROOT=$NA(^TMP("TIULQ",$J,TIUDA,"ZADD",TIUADD))
54 I +$D(@TIUROOT@("EXTRASGNR")) D Q:'TIUCONT ;**100** added the quit
55 . N TIUI S TIUI=0
56 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
57 . F S TIUI=$O(@TIUROOT@("EXTRASGNR",TIUI)) Q:'TIUI D
58 . . W !!?4,"Receipt Acknowledged By:"
59 . . ;VMP/ELR P224 ADDED code to print awaiting signature and expected additional signer name
60 . . I +$G(@TIUROOT@("EXTRASGNR",TIUI,"DATE"))'>0 D Q
61 . . . W !,?4,"* AWAITING SIGNATURE *",?30,$G(@TIUROOT@("EXTRASGNR",TIUI,"EXPNAME"))
62 . . I TIUI>1 S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
63 . . W !?29,"/es/ ",$G(@TIUROOT@("EXTRASGNR",TIUI,"NAME"))
64 . . I $L($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")))>45 D
65 . . . N TIUFT
66 . . . D WRAP^TIUFLD($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")),45)
67 . . . W !?34,$G(TIUFT(1))
68 . . . W !?39,$G(TIUFT(2))
69 . . I $L($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")))<46 W !?34,$G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE"))
70 . . I $G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA")),$G(@TIUROOT@("EXTRASGNR",TIUI,"EXPIEN"))'=$G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA")) D
71 . . . W !?30,"for ",$P($G(@TIUROOT@("EXTRASGNR",TIUI,"EXPNAME")),",",2)
72 . . . W " ",$P($G(@TIUROOT@("EXTRASGNR",TIUI,"EXPNAME")),",")
73 . . W !?34,$$DATE^TIULS($G(@TIUROOT@("EXTRASGNR",TIUI,"DATE")),"MM/DD/CCYY HR:MIN")
74 . . I '+$G(TIUFLAG)!($E(IOST)="C-") D
75 . . . N BEEP
76 . . . S BEEP=$$BEEP^TIULC1(+$G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA")))
77 . . . I +BEEP W !?34,"Analog Pager: ",$P(BEEP,U)
78 . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2)
79 . ;K @TIUROOT@("EXTRASGNR") ;**100** commented out
80 ;I +TIUSIG("COSGDATE"),(+TIUSIG("COSGEDBY")'=+TIUSIG("SIGNEDBY")) D Q:'TIUCONT
81 I +TIUSIG("COSGDATE") D Q:'TIUCONT
82 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
83 . W !!?16,"Cosigned by:",$S($P(TIUSIG("COSGMODE"),";")="C":" /s/ ",1:" /es/ "),?34,$S(TIUSIG("COSGNAME")]"":TIUSIG("COSGNAME"),1:$P(TIUSIG("COSGEDBY"),";",2))
84 . I $L(TIUSIG("COSGTITL"))>45 D
85 . . N TIUFT
86 . . D WRAP^TIUFLD(TIUSIG("COSGTITL"),45)
87 . . W !?34,$G(TIUFT(1))
88 . . W !?39,$G(TIUFT(2))
89 . I $L(TIUSIG("COSGTITL"))<46 W !?34,TIUSIG("COSGTITL")
90 . W !?34,$$DATE^TIULS(+TIUSIG("COSGDATE"),"MM/DD/CCYY HR:MIN")
91 . I '+$G(TIUFLAG)!($E(IOST)="C-") D
92 . . I $P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U) W !?34,"Analog Pager: ",$P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U)
93 . . I $P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U,2) W !?34,"Digital Pager: ",$P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U,2)
94 ;I +TIUSIG("COSCHRT"),$P(TIUSIG("COSGMODE"),";")="C" D Q:'TIUCONT
95 I $P(TIUSIG("COSGMODE"),";")="C" D Q:'TIUCONT
96 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT
97 . W !,"Marked cosigned on chart by:",?34,$P(TIUSIG("COSCHRT"),";",2)
98 W !
99 ;K TIUCONT1 ; kills the cont on next page msgs since no longer in middle
100 ;of a note. **100** moved down to amend code
101AMEND ; signature blocks of amender
102 ;N TIUY S TIUY=4 ;I don't think we need TIUY anymore **100**
103 I '$G(@TIUROOT@(1601,"I")) K TIUCONT1 Q
104 S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT))
105 K TIUCONT1 Q:'TIUCONT
106 I +$G(@TIUROOT@(1601,"I")) D
107 . W !!?12,"Amendment Filed:",?34,$$DATE^TIULS(@TIUROOT@(1601,"I"),"MM/DD/CCYY HR:MIN")
108 . I $G(@TIUROOT@(1603,"E"))']"" D
109 . . W !!?29 F TIUI=1:1:40 W "_"
110 . . W !?29,$$SIGNAME^TIULS(@TIUROOT@(1602,"I"))
111 . . W !?29,$$SIGTITL^TIULS(@TIUROOT@(1602,"I"))
112 . I $G(@TIUROOT@(1604,"E"))]"" D
113 . . W !?29,"/es/",?34,@TIUROOT@(1604,"E")
114 . . W !?34,@TIUROOT@(1605,"E")
115 Q
116 ;
Note: See TracBrowser for help on using the repository browser.