- 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 Feb 19, 2025@00:10:07 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")