source: WorldVistAEHR/trunk/r/SURGERY-SR/SROESPR.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1SROESPR ;BIR/ADM - SURGERY E-SIG UTILITY ;08/09/04
2 ;;3.0; Surgery ;**100,129,134**;24 Jun 93
3 ;** NOTICE: This routine is part of an implementation of a nationally
4 ;** controlled procedure. Local modifications to this routine
5 ;** are prohibited.
6 ;
7 ; Reference to $$PRNTGRP^TIULG supported by DBIA #3003
8 ; Reference to $$PRNTMTHD^TIULG supported by DBIA #3003
9 ; Reference to $$PRNTNBR^TIULG supported by DBIA #3003
10 ; Reference to EXTRACT^TIULQ supported by DBIA #2693
11 ; Reference to ^TMP("TIUPR",$J) supported by DBIA #4377
12 ; Reference to DOCPARM^TIUSRVP1 supported by DBIA #4331
13 ; Reference to $$ISA^USRLM supported by DBIA #2324
14 ;
15ENTRY ; Entry point to print reports
16 N SRFLAG,SRI,SRJ,SRK,SRL,SRM,SRN,SRO,SRPGRP,SRPFHDR,SRSPG
17 I $G(TIUFLAG) S SRFLAG=TIUFLAG
18 I '$O(^TMP("SRPR",$J,0)) M ^TMP("SRPR",$J)=^TMP("TIUPR",$J)
19 S SRI="" F S SRI=$O(^TMP("SRPR",$J,SRI)) Q:SRI="" S SRJ="" F S SRJ=$O(^TMP("SRPR",$J,SRI,SRJ)) Q:SRJ="" S SRK="" F S SRK=$O(^TMP("SRPR",$J,SRI,SRJ,SRK)) Q:SRK="" D
20 .S SRPGRP=$P(SRI,"$"),SRL=$P(SRI,"$",2),SRM=$P(SRL,";"),SRN=$P(SRL,";",2)
21 .S SRPFHDR=$$TITLE^SROESPR(SRK)
22 .S SRO("SRPR",$J,SRPGRP_"$"_SRPFHDR_";"_SRN,SRJ,SRK)=^TMP("SRPR",$J,SRI,SRJ,SRK)
23 .K ^TMP("SRPR",$J,SRI,SRJ,SRK)
24 M ^TMP("SRPR",$J)=SRO("SRPR",$J)
25 U IO
26ENTRY1 ; Entry point from above
27 N SRERR,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT
28 I $E(IOST,1,2)="C-" S (SRSPG,SRFLAG)=1
29 I '+$G(SRFLAG) S SRSPG=1
30 K ^TMP("SRLQ",$J)
31 I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
32 D PRINT^SROESPR1($G(SRFLAG),$G(SRSPG))
33EXIT K ^TMP("SRLQ",$J),^TMP("SRPR",$J)
34 Q
35PRNT(SRTN,SRTIU,SRDTITL) ; print report from TIU
36 N DFN,SRDARR,SRFLAG,SRPFHDR,SRPFNBR,SRPGRP,SRPMTHD,SRSPG,SRTYP
37 K ^TMP("SRPR",$J) S SRFLAG=$$FLAG Q:SRFLAG="" I $G(SRDTITL)="" S SRDTITL="Surgery Print TIU Document"
38 S DFN=$P(^SRF(SRTN,0),"^"),SRTYP=$$TYPE(SRTIU) Q:'+SRTYP
39 S SRPMTHD=$$PRNTMTHD^TIULG(+SRTYP)
40 S SRPGRP=$$PRNTGRP^TIULG(+SRTYP)
41 S SRPFHDR=$$TITLE(SRTIU)
42 S SRPFNBR=$$PRNTNBR^TIULG(+SRTYP)
43 I $G(SRPMTHD)]"",+$G(SRPGRP),($G(SRPFHDR)]""),($G(SRPFNBR)]"") S SRDARR(SRPMTHD,+$G(SRPGRP)_"$"_$G(SRPFHDR)_";"_DFN,1,SRTIU)=$G(SRPFNBR)
44 E S SRDARR(SRPMTHD,DFN,1,SRTIU)=""
45 I $G(SRPMTHD)']"" W !,$C(7),"No Print Method Defined" H 2 Q
46 M ^TMP("SRPR",$J)=SRDARR(SRPMTHD)
47DEVICE I IOST'["P-" W ! K IOP S %ZIS="Q" D ^%ZIS I POP K POP G EXIT
48 S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG)
49 I $D(IO("Q")) K IO("Q") D G EXIT
50 .S ZTRTN="ENTRY1^SROESPR",ZTSAVE("^TMP(""SRPR"",$J,")=""
51 .S ZTSAVE("SRFLAG")="",ZTSAVE("SRSPG")="",ZTDESC=SRDTITL
52 .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
53 .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,SRFLAG,SRSPG
54 .D HOME^%ZIS
55 U IO D ENTRY1,^%ZISC
56 Q
57TYPE(SRTIU) ; get document type
58 N SRY,SRERR D EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".01")
59 Q SRY(SRTIU,.01,"I")
60TITLE(SRTIU) ; get report title
61 N SRY,SRERR D EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".01")
62 Q SRY(SRTIU,.01,"E")
63FLAG() ; chart vs work copies
64 ; returns SRFLAG=1 if chart copy, SRFLAG=0 if work copy, null if '^'
65 D DOCPARM^TIUSRVP1(.SRPARM,SRTIU) I +$P($G(SRPARM(0)),"^",9)'>0,'(+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")) S SRFLAG=0 Q SRFLAG
66 I IOST["P-" S SRFLAG=0 Q SRFLAG
67 S SRFLAG="" W ! K DIR S DIR("A")="Do you want WORK copies or CHART copies? ",DIR("B")="WORK",DIR(0)="SA^C:CHART;W:WORK"
68 S DIR("?",1)=" The FOOTERs of WORK/CHART copies vary significantly. The WORK",DIR("?",2)=" FOOTER has the patient's phone number and is clearly marked:"
69 S DIR("?",3)=" 'NOT FOR MEDICAL RECORD'. Unless you really intend to file the",DIR("?")=" note(s) in the chart- print a WORK copy."
70 D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q SRFLAG
71 S SRFLAG=$S(Y="C":1,1:0)
72 Q SRFLAG
73PAT(SRY,DFN) ; get minimum demographics for print
74 N VADM,VAIP,VAIN,VAPA,VA D OERR^VADPT,ADD^VADPT
75 S SRY("PNMP")=$E($G(VADM(1)),1,30),SRY("SSN")=$G(VA("PID"))
76 S SRY("DOB")="DOB:"_$$DATE(+$G(VADM(3)),"MM/DD/CCYY")
77 S SRY("PH#")="Ph:"_$S($G(VAPA(8))'="":VAPA(8),1:"**UNKNOWN**")
78 S SRY("INTNM")=$$NAME^VASITE ;Integration Name
79 S SRY("SITE")=$P($$SITE^VASITE,U,2)
80 S SRY("LOCP")="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
81 Q
82TIME(X,FMT) ; receives X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
83 N HR,MIN,SEC,SRI I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
84 S X=$P(X,".",2),HR=$E(X,1,2)_$E("00",0,2-$L($E(X,1,2))),MIN=$E(X,3,4)_$E("00",0,2-$L($E(X,3,4))),SEC=$E(X,5,6)_$E("00",0,2-$L($E(X,5,6)))
85 F SRI="HR","MIN","SEC" S:FMT[SRI FMT=$P(FMT,SRI)_@SRI_$P(FMT,SRI,2)
86 Q FMT
87DATE(X,FMT) ; call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
88 N AMTH,MM,CC,DD,YY,SRI,SRTMP
89 I +X'>0 S $P(SRTMP," ",$L($G(FMT))+1)="",FMT=SRTMP G QDATE
90 I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
91 S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
92 S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
93 F SRI="AMTH","MM","DD","CC","YY" S:FMT[SRI FMT=$P(FMT,SRI)_@SRI_$P(FMT,SRI,2)
94 I FMT["HR" S FMT=$$TIME(X,FMT)
95QDATE Q FMT
96BEEP(SRPER) ; get beeper #'s
97 N SRDP,SRVP,SRY S (SRDP,SRVP)="" K DA,DIC,DR,DIQ
98 S DIC=200,DA=+SRPER,DR=".137;.138",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
99 S SRVP=SRY(200,+SRPER,.137,"I"),SRDP=SRY(200,+SRPER,.138,"I")
100 Q SRVP_"^"_SRDP
101SIGNAME(SRPER) ; get signature block printed name
102 N SRY K DA,DIC,DR,DIQ
103 S DIC=200,DA=+SRPER,DR="20.2",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
104 Q SRY(200,+SRPER,20.2,"I")
105SIGTITL(SRPER) ; get signature block title
106 N SRY K DA,DIC,DR,DIQ
107 S DIC=200,DA=+SRPER,DR="20.3",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
108 Q SRY(200,+SRPER,20.3,"I")
Note: See TracBrowser for help on using the repository browser.