- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPRPN8.m
r613 r623 1 TIUPRPN8 ;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 ; 4 SIGBLK(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 101 AMEND ; 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 ; 1 TIUPRPN8 ;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**;Jun 20, 1997 3 ; 4 SIGBLK(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 . W !?4,"Receipt Acknowledged By:" 58 . F S TIUI=$O(@TIUROOT@("EXTRASGNR",TIUI)) Q:'TIUI D 59 . . I +$G(@TIUROOT@("EXTRASGNR",TIUI,"DATE"))'>0 Q 60 . . I TIUI>1 S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT 61 . . W !?29,"/es/ ",$G(@TIUROOT@("EXTRASGNR",TIUI,"NAME")) 62 . . I $L($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")))>45 D 63 . . . N TIUFT 64 . . . D WRAP^TIUFLD($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")),45) 65 . . . W !?34,$G(TIUFT(1)) 66 . . . W !?39,$G(TIUFT(2)) 67 . . I $L($G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")))<46 W !?34,$G(@TIUROOT@("EXTRASGNR",TIUI,"TITLE")) 68 . . I $G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA")),$G(@TIUROOT@("EXTRASGNR",TIUI,"EXPIEN"))'=$G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA")) D 69 . . . W !?30,"for ",$P($G(@TIUROOT@("EXTRASGNR",TIUI,"EXPNAME")),",",2) 70 . . . W " ",$P($G(@TIUROOT@("EXTRASGNR",TIUI,"EXPNAME")),",") 71 . . W !?34,$$DATE^TIULS($G(@TIUROOT@("EXTRASGNR",TIUI,"DATE")),"MM/DD/CCYY HR:MIN") 72 . . I '+$G(TIUFLAG)!($E(IOST)="C-") D 73 . . . N BEEP 74 . . . S BEEP=$$BEEP^TIULC1(+$G(@TIUROOT@("EXTRASGNR",TIUI,"EXTRA"))) 75 . . . I +BEEP W !?34,"Analog Pager: ",$P(BEEP,U) 76 . . . I +$P(BEEP,U,2) W !?34,"Digital Pager: ",$P(BEEP,U,2) 77 . ;K @TIUROOT@("EXTRASGNR") ;**100** commented out 78 ;I +TIUSIG("COSGDATE"),(+TIUSIG("COSGEDBY")'=+TIUSIG("SIGNEDBY")) D Q:'TIUCONT 79 I +TIUSIG("COSGDATE") D Q:'TIUCONT 80 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT 81 . W !!?16,"Cosigned by:",$S($P(TIUSIG("COSGMODE"),";")="C":" /s/ ",1:" /es/ "),?34,$S(TIUSIG("COSGNAME")]"":TIUSIG("COSGNAME"),1:$P(TIUSIG("COSGEDBY"),";",2)) 82 . I $L(TIUSIG("COSGTITL"))>45 D 83 . . N TIUFT 84 . . D WRAP^TIUFLD(TIUSIG("COSGTITL"),45) 85 . . W !?34,$G(TIUFT(1)) 86 . . W !?39,$G(TIUFT(2)) 87 . I $L(TIUSIG("COSGTITL"))<46 W !?34,TIUSIG("COSGTITL") 88 . W !?34,$$DATE^TIULS(+TIUSIG("COSGDATE"),"MM/DD/CCYY HR:MIN") 89 . I '+$G(TIUFLAG)!($E(IOST)="C-") D 90 . . I $P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U) W !?34,"Analog Pager: ",$P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U) 91 . . I $P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U,2) W !?34,"Digital Pager: ",$P($$BEEP^TIULC1(+TIUSIG("COSGEDBY")),U,2) 92 ;I +TIUSIG("COSCHRT"),$P(TIUSIG("COSGMODE"),";")="C" D Q:'TIUCONT 93 I $P(TIUSIG("COSGMODE"),";")="C" D Q:'TIUCONT 94 . S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) Q:'TIUCONT 95 . W !,"Marked cosigned on chart by:",?34,$P(TIUSIG("COSCHRT"),";",2) 96 W ! 97 ;K TIUCONT1 ; kills the cont on next page msgs since no longer in middle 98 ;of a note. **100** moved down to amend code 99 AMEND ; signature blocks of amender 100 ;N TIUY S TIUY=4 ;I don't think we need TIUY anymore **100** 101 I '$G(@TIUROOT@(1601,"I")) K TIUCONT1 Q 102 S TIUCONT=$$SETCONT^TIUPRPN1(.TIUFOOT,TIUMISC,TIUCONT1,0,$G(TIUROOT)) 103 K TIUCONT1 Q:'TIUCONT 104 I +$G(@TIUROOT@(1601,"I")) D 105 . W !!?12,"Amendment Filed:",?34,$$DATE^TIULS(@TIUROOT@(1601,"I"),"MM/DD/CCYY HR:MIN") 106 . I $G(@TIUROOT@(1603,"E"))']"" D 107 . . W !!?29 F TIUI=1:1:40 W "_" 108 . . W !?29,$$SIGNAME^TIULS(@TIUROOT@(1602,"I")) 109 . . W !?29,$$SIGTITL^TIULS(@TIUROOT@(1602,"I")) 110 . I $G(@TIUROOT@(1604,"E"))]"" D 111 . . W !?29,"/es/",?34,@TIUROOT@(1604,"E") 112 . . W !?34,@TIUROOT@(1605,"E") 113 Q 114 ;
Note:
See TracChangeset
for help on using the changeset viewer.
