109 lines
5.4 KiB
Mathematica
109 lines
5.4 KiB
Mathematica
SROESPR ;BIR/ADM - SURGERY E-SIG UTILITY ;08/09/04
|
|
;;3.0; Surgery ;**100,129,134**;24 Jun 93
|
|
;** NOTICE: This routine is part of an implementation of a nationally
|
|
;** controlled procedure. Local modifications to this routine
|
|
;** are prohibited.
|
|
;
|
|
; Reference to $$PRNTGRP^TIULG supported by DBIA #3003
|
|
; Reference to $$PRNTMTHD^TIULG supported by DBIA #3003
|
|
; Reference to $$PRNTNBR^TIULG supported by DBIA #3003
|
|
; Reference to EXTRACT^TIULQ supported by DBIA #2693
|
|
; Reference to ^TMP("TIUPR",$J) supported by DBIA #4377
|
|
; Reference to DOCPARM^TIUSRVP1 supported by DBIA #4331
|
|
; Reference to $$ISA^USRLM supported by DBIA #2324
|
|
;
|
|
ENTRY ; Entry point to print reports
|
|
N SRFLAG,SRI,SRJ,SRK,SRL,SRM,SRN,SRO,SRPGRP,SRPFHDR,SRSPG
|
|
I $G(TIUFLAG) S SRFLAG=TIUFLAG
|
|
I '$O(^TMP("SRPR",$J,0)) M ^TMP("SRPR",$J)=^TMP("TIUPR",$J)
|
|
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
|
|
.S SRPGRP=$P(SRI,"$"),SRL=$P(SRI,"$",2),SRM=$P(SRL,";"),SRN=$P(SRL,";",2)
|
|
.S SRPFHDR=$$TITLE^SROESPR(SRK)
|
|
.S SRO("SRPR",$J,SRPGRP_"$"_SRPFHDR_";"_SRN,SRJ,SRK)=^TMP("SRPR",$J,SRI,SRJ,SRK)
|
|
.K ^TMP("SRPR",$J,SRI,SRJ,SRK)
|
|
M ^TMP("SRPR",$J)=SRO("SRPR",$J)
|
|
U IO
|
|
ENTRY1 ; Entry point from above
|
|
N SRERR,D0,DN,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|
I $E(IOST,1,2)="C-" S (SRSPG,SRFLAG)=1
|
|
I '+$G(SRFLAG) S SRSPG=1
|
|
K ^TMP("SRLQ",$J)
|
|
I $D(ZTQUEUED) S ZTREQ="@" ; Tell TaskMan to delete Task log entry
|
|
D PRINT^SROESPR1($G(SRFLAG),$G(SRSPG))
|
|
EXIT K ^TMP("SRLQ",$J),^TMP("SRPR",$J)
|
|
Q
|
|
PRNT(SRTN,SRTIU,SRDTITL) ; print report from TIU
|
|
N DFN,SRDARR,SRFLAG,SRPFHDR,SRPFNBR,SRPGRP,SRPMTHD,SRSPG,SRTYP
|
|
K ^TMP("SRPR",$J) S SRFLAG=$$FLAG Q:SRFLAG="" I $G(SRDTITL)="" S SRDTITL="Surgery Print TIU Document"
|
|
S DFN=$P(^SRF(SRTN,0),"^"),SRTYP=$$TYPE(SRTIU) Q:'+SRTYP
|
|
S SRPMTHD=$$PRNTMTHD^TIULG(+SRTYP)
|
|
S SRPGRP=$$PRNTGRP^TIULG(+SRTYP)
|
|
S SRPFHDR=$$TITLE(SRTIU)
|
|
S SRPFNBR=$$PRNTNBR^TIULG(+SRTYP)
|
|
I $G(SRPMTHD)]"",+$G(SRPGRP),($G(SRPFHDR)]""),($G(SRPFNBR)]"") S SRDARR(SRPMTHD,+$G(SRPGRP)_"$"_$G(SRPFHDR)_";"_DFN,1,SRTIU)=$G(SRPFNBR)
|
|
E S SRDARR(SRPMTHD,DFN,1,SRTIU)=""
|
|
I $G(SRPMTHD)']"" W !,$C(7),"No Print Method Defined" H 2 Q
|
|
M ^TMP("SRPR",$J)=SRDARR(SRPMTHD)
|
|
DEVICE I IOST'["P-" W ! K IOP S %ZIS="Q" D ^%ZIS I POP K POP G EXIT
|
|
S SRFLAG=+$G(SRFLAG),SRSPG=+$G(SRSPG)
|
|
I $D(IO("Q")) K IO("Q") D G EXIT
|
|
.S ZTRTN="ENTRY1^SROESPR",ZTSAVE("^TMP(""SRPR"",$J,")=""
|
|
.S ZTSAVE("SRFLAG")="",ZTSAVE("SRSPG")="",ZTDESC=SRDTITL
|
|
.D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
|
|
.K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,SRFLAG,SRSPG
|
|
.D HOME^%ZIS
|
|
U IO D ENTRY1,^%ZISC
|
|
Q
|
|
TYPE(SRTIU) ; get document type
|
|
N SRY,SRERR D EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".01")
|
|
Q SRY(SRTIU,.01,"I")
|
|
TITLE(SRTIU) ; get report title
|
|
N SRY,SRERR D EXTRACT^TIULQ(SRTIU,"SRY",.SRERR,".01")
|
|
Q SRY(SRTIU,.01,"E")
|
|
FLAG() ; chart vs work copies
|
|
; returns SRFLAG=1 if chart copy, SRFLAG=0 if work copy, null if '^'
|
|
D DOCPARM^TIUSRVP1(.SRPARM,SRTIU) I +$P($G(SRPARM(0)),"^",9)'>0,'(+$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")) S SRFLAG=0 Q SRFLAG
|
|
I IOST["P-" S SRFLAG=0 Q SRFLAG
|
|
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"
|
|
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:"
|
|
S DIR("?",3)=" 'NOT FOR MEDICAL RECORD'. Unless you really intend to file the",DIR("?")=" note(s) in the chart- print a WORK copy."
|
|
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) Q SRFLAG
|
|
S SRFLAG=$S(Y="C":1,1:0)
|
|
Q SRFLAG
|
|
PAT(SRY,DFN) ; get minimum demographics for print
|
|
N VADM,VAIP,VAIN,VAPA,VA D OERR^VADPT,ADD^VADPT
|
|
S SRY("PNMP")=$E($G(VADM(1)),1,30),SRY("SSN")=$G(VA("PID"))
|
|
S SRY("DOB")="DOB:"_$$DATE(+$G(VADM(3)),"MM/DD/CCYY")
|
|
S SRY("PH#")="Ph:"_$S($G(VAPA(8))'="":VAPA(8),1:"**UNKNOWN**")
|
|
S SRY("INTNM")=$$NAME^VASITE ;Integration Name
|
|
S SRY("SITE")=$P($$SITE^VASITE,U,2)
|
|
S SRY("LOCP")="Pt Loc: "_$S(VAIN(4)]"":$P(VAIN(4),U,2)_" "_VAIN(5),1:"OUTPATIENT")
|
|
Q
|
|
TIME(X,FMT) ; receives X as 2910419.01 and FMT=Return Format of time (HH:MM:SS).
|
|
N HR,MIN,SEC,SRI I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="HR:MIN"
|
|
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)))
|
|
F SRI="HR","MIN","SEC" S:FMT[SRI FMT=$P(FMT,SRI)_@SRI_$P(FMT,SRI,2)
|
|
Q FMT
|
|
DATE(X,FMT) ; call with X=2910419.01 and FMT=Return Format of date ("MM/DD")
|
|
N AMTH,MM,CC,DD,YY,SRI,SRTMP
|
|
I +X'>0 S $P(SRTMP," ",$L($G(FMT))+1)="",FMT=SRTMP G QDATE
|
|
I $S('$D(FMT):1,'$L(FMT):1,1:0) S FMT="MM/DD/YY"
|
|
S MM=$E(X,4,5),DD=$E(X,6,7),YY=$E(X,2,3),CC=17+$E(X)
|
|
S:FMT["AMTH" AMTH=$P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC","^",+MM)
|
|
F SRI="AMTH","MM","DD","CC","YY" S:FMT[SRI FMT=$P(FMT,SRI)_@SRI_$P(FMT,SRI,2)
|
|
I FMT["HR" S FMT=$$TIME(X,FMT)
|
|
QDATE Q FMT
|
|
BEEP(SRPER) ; get beeper #'s
|
|
N SRDP,SRVP,SRY S (SRDP,SRVP)="" K DA,DIC,DR,DIQ
|
|
S DIC=200,DA=+SRPER,DR=".137;.138",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
|
|
S SRVP=SRY(200,+SRPER,.137,"I"),SRDP=SRY(200,+SRPER,.138,"I")
|
|
Q SRVP_"^"_SRDP
|
|
SIGNAME(SRPER) ; get signature block printed name
|
|
N SRY K DA,DIC,DR,DIQ
|
|
S DIC=200,DA=+SRPER,DR="20.2",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
|
|
Q SRY(200,+SRPER,20.2,"I")
|
|
SIGTITL(SRPER) ; get signature block title
|
|
N SRY K DA,DIC,DR,DIQ
|
|
S DIC=200,DA=+SRPER,DR="20.3",DIQ="SRY",DIQ(0)="I" D EN^DIQ1 K DA,DIC,DR,DIQ
|
|
Q SRY(200,+SRPER,20.3,"I")
|