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