ECXPHAA ;ALB/JRC Pharmacy DSS Extract UDP/IVP Source Audit Report ;3/13/18 14:33
;;3.0;DSS EXTRACTS;**92,142,149,161,166,170**;Dec 22, 1997;Build 12
;
EN ;entry point from option
N SCRNARR,STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT ;149
S SCRNARR="^TMP($J,""ECXPHAA"")",STOP=0
K @SCRNARR
S STOP=0
;Select report
D REPORT Q:STOP
;Select division
D DIVISION Q:STOP
;Select date range
D DATES Q:STOP
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q ;149 Section added
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="DIVISION^DATE^RECORD COUNT",CNT=1
.D @$S(REPORT=2:"GETUDATA",REPORT=1:"GETIDATA",1:"") ;tjl 166 Changed order
.D DETAIL
.D EXPDISP^ECXUTL1
.K ^TMP($J,"ECXPORT"),^TMP($J,"ECXPHAA")
;Queue Report
N ZTDESC,ZTIO,ZTSAVE
F X="REPORT","SDATE","EDATE","STOP" S ZTSAVE(X)=""
S ZTSAVE("SCRNARR")=""
S TMP=$$OREF^DILF(SCRNARR)
S ZTSAVE(TMP)=""
I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
S ZTIO=""
S ZTDESC="DSS UDP/IVP Source Audit Report"
D EN^XUTMDEVQ("EN1^ECXPHAA",ZTDESC,.ZTSAVE)
Q
;
EN1 ;Init variables
N PAGE,LN,SUB
S SUB="",PAGE=0
D HEADER I STOP D EXIT Q
S SUB=$S(REPORT=2:"GETUDATA",REPORT=1:"GETIDATA",1:"") ;tjl 166 Changed order
D @SUB I STOP D EXIT Q
I '$O(^TMP($J,"ECXPHAA",0)) D Q
.W !
.W !,"************************************************************"
.W !,"* NOTHING TO REPORT FOR PHARMACY "_$S(REPORT=2:"UDP",REPORT=1:"IVP",1:"")_" SOURCE AUDIT REPORT *"
.W !,"************************************************************"
.D WAIT
.D EXIT
D DETAIL I STOP D EXIT Q
EXIT K @SCRNARR Q
;
REPORT ;Select report
N DIR,DIRUT,DUOUT
;Prepare choices
S DIR(0)="S^1:IVP;2:UDP" ;tjl 166 Changed order
S DIR("A")="Select Source Audit Report"
D ^DIR
I $D(DIRUT)!$D(DUOUT) S STOP=1 Q
S REPORT=Y
Q
;
DIVISION ;Prompt for division
; Set Divisions into screen array (prompt is one/many/all)
;Input : SCRNARR - Screen array full global reference
;Output : 1 = OK 0 = User abort/timeout
; @SCRNARR@("DIVISION") = User pick all divisions ?
; 1 = Yes (all) 0 = No
; @SCRNARR@("DIVISION",PtrDiv) = Division name
;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
; picked individual divisions (i.e. didn't pick all)
;
;Declare variables
N VAUTD,Y,DIV,FAC
;Get division selection
D DIVISION^VAUTOMA
I Y<0 S STOP=1 Q
M @SCRNARR@("DIVISION")=VAUTD
I VAUTD=0 D
.S DIV=0 F S DIV=$O(VAUTD(DIV)) Q:DIV'>0 S FAC=$$GETDIV^ECXDEPT(DIV) S @SCRNARR@("DIVISION",FAC)=""
Q
;
DATES ;Prompt for start date
N DIR,DIRUT,X,Y
S DIR(0)="D^:NOW:EX"
S DIR("A")="Enter Report Start Date"
S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
D ^DIR
I $D(DIRUT) S STOP=1 Q
S SDATE=Y
;Prompt for end date
K DIR,DIRUT,X,Y
S DIR(0)="D^:NOW:EX"
S DIR("A")="Enter Report End Date"
S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
D ^DIR
I $D(DIRUT) S STOP=1 Q
S EDATE=Y
Q
;
S PAGE=$G(PAGE)+1,$P(LN,"=",80)=""
W @IOF
W !,$S(REPORT=2:"UDP",REPORT=1:"IVP",1:"")_" Source Audit Report",?70,"PAGE: "_PAGE
W !!,"Run Date: "_$$FMTE^XLFDT(DT)
W !!,"Start Date: "_$$FMTE^XLFDT(SDATE)
W !,"End Date: "_$$FMTE^XLFDT(EDATE)
W !!,?1,"Division",?24,"Date",?39,"Record Count"
W !,LN
Q
;
GETIDATA ;Get data from pharmacy IVP intermediate files
;Init variables
N DATE,FILE,DFN,ERROR,ON,DA,ECPAT,EC,ENDATE ;161
S DATE=SDATE-.1,ENDATE=EDATE+.999,FILE=728.113 ;161
F S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>ENDATE) D Q:STOP ;161
.S DFN=0 F S DFN=$O(^ECX(FILE,"A",DATE,DFN)) Q:'DFN D Q:STOP
..;Filter out test patients or bad records
..;patch 142--corrected to not display test patients
..S ERROR=$$PAT^ECXNUT(DFN) Q:ERROR
..S ON=0 F S ON=$O(^ECX(FILE,"A",DATE,DFN,ON)) Q:'ON D Q:STOP
...S DA=0 F S DA=$O(^ECX(FILE,"A",DATE,DFN,ON,DA)) Q:'DA!(STOP) D Q:STOP
....I $D(^ECX(728.113,DA,0)) S EC=^(0) D Q:STOP
.....;get inpatient data if exist
.....N MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC ;161
.....N DIC,DIQ,DR,ECXDIC,DA
.....S (MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC)="" ;161
.....S WARD=$$GET1^DIQ(55.01,ON_","_DFN_",",104,"I") ;161 Get ward information from pharmacy order
.....S:WARD=0 WARD=$$GETWARD ;170 If ward=0, indicating an error in pharmacy, get ward at time of IV
.....S:WARD=.5 WARD="" S:WARD'="" WARD=WARD_";"_$$GET1^DIQ(42,WARD,.015,"I") ;161 Ward of .5 indicates outpatient
.....I WARD'="" S DIVISION=$$GETDIV^ECXDEPT($P(WARD,";",2)) ;161
.....I WARD="" D Q:STOP ;161
......;Get division from outpatient location file 44
......S CLINIC=+$P(EC,U,13)
......S DIC="^SC(",DIQ(0)="I",DIQ="ECXDIC",DR="3.5",DA=CLINIC ;161
......D EN^DIQ1
......S DIVISION=$$GETDIV^ECXDEPT(+$G(ECXDIC(44,CLINIC,3.5,"I"))) ;161
......S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN")
.....I DIVISION="UNKNOWN",$P(EC,U,15) D ;161 Section added to get information from IV room if no ward or clinic is available
......S DIVISION=$$GETDIV^ECXDEPT($$PSJ59P5^ECXUTL5($P(EC,U,15)))
.....;Save in temp global and filter division
.....I '@SCRNARR@("DIVISION")=1&'($D(@SCRNARR@("DIVISION",DIVISION))) Q
.....S ^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION)=$G(^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION))+1
Q
;
GETUDATA ;Get unit dose data from intermediate file 728.904
;Init variables
N DATE,FILE,RECORD,DATA,DFN,ERROR,ON,WARD,DIVISION,DIC,DIQ,DR,DA,ECPAT,CLINIC,COUNT,L,ECXDIC,ENDATE ;149,161
S DATE=SDATE-.1,ENDATE=EDATE+.999,STOP=0 ;161
S FILE=728.904
F S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>ENDATE) D Q:STOP ;161
.S RECORD=0 F S RECORD=$O(^ECX(FILE,"A",DATE,RECORD)) Q:'RECORD D Q:STOP
..S DATA=$G(^ECX(FILE,RECORD,0)),DFN=$P(DATA,U,2)
..;Filter out test patients or bad records
..;patch 142-corrected to not display test patients
..S ERROR=$$PAT^ECXNUT(DFN) Q:ERROR
..S ON=$P(DATA,U,10),WARD=$P(DATA,U,6)
..S DIVISION=$$GETDIV^ECXDEPT($P($G(^DIC(42,+WARD,0)),U,11))
..I WARD=""&(ON) D Q:STOP ;161
...;Get division from outpatient location from file 44
...S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="62",DR(55.06)="130",DA=DFN
...S DA(55.06)=+ON D EN^DIQ1
...S CLINIC=+$G(ECXDIC(55.06,+ON,130,"I")) ;161
...S DIC="^SC(",DIQ(0)="I",DIQ="ECXDIC",DR=3.5,DA=CLINIC D EN^DIQ1 ;161
...S DIVISION=$$GETDIV^ECXDEPT(+$G(ECXDIC(44,CLINIC,3.5,"I"))) ;161
...S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN") K ECXDIC ;161
..;Save in temp global and filter division
..I '@SCRNARR@("DIVISION")=1&'($D(@SCRNARR@("DIVISION",DIVISION))) Q
..S ^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION)=$G(^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION))+1
Q
;
DETAIL ;Print report
;Init variables
N DATE,DIV,COUNT ;149
S (DATE,COUNT)=0,DIV="" ;149
F S DATE=$O(^TMP($J,"ECXPHAA",DATE)) Q:'DATE!(STOP) F S DIV=$O(^TMP($J,"ECXPHAA",DATE,DIV)) Q:DIV=""!(STOP) S COUNT=^(DIV) D ;149
.I $G(ECXPORT) S ^TMP($J,"ECXPORT",CNT)=DIV_U_$$FMTE^XLFDT(DATE)_U_COUNT,CNT=CNT+1 Q ;149
.W !,?1,DIV,?20,$$FMTE^XLFDT(DATE),?45,COUNT I $Y>(IOSL-5) D WAIT Q:STOP D HEADER ;149
Q
;
WAIT ;End of page logic
;Input ; None
;Output ; STOP - Flag indicating if printing should continue
; 1 = Stop 0 = Continue
;
S STOP=0
;CRT - Prompt for continue
I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
.F Q:$Y>(IOSL-3) W !
.N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
.S DIR(0)="E"
.D ^DIR
.S STOP=$S(Y'=1:1,1:0)
;Background task - check taskman
S STOP=$$S^%ZTLOAD()
I STOP D
.W !,"*********************************************"
.W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
.W !,"*********************************************"
Q
;
GETWARD() ;170 Section added to find ward at time of IV when ward is incorrectly set to 0 in pharmacy
N EVDT,VAIP,WARDODT ;Ward on d/t
S EVDT=$P(EC,U,5) ;Get IV date/time
S VAIP("D")=EVDT
D IN5^VADPT ;Get inpt information
S WARDODT=$P(VAIP(5),U) ;IEN of ward
S:'+WARDODT WARDODT="" ;If ward not found, set it to null
Q WARDODT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXPHAA 8128 printed Apr 09, 2024@20:57:36 Page 2
ECXPHAA ;ALB/JRC Pharmacy DSS Extract UDP/IVP Source Audit Report ;3/13/18 14:33
+1 ;;3.0;DSS EXTRACTS;**92,142,149,161,166,170**;Dec 22, 1997;Build 12
+2 ;
EN ;entry point from option
+1 ;149
NEW SCRNARR,STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT
+2 SET SCRNARR="^TMP($J,""ECXPHAA"")"
SET STOP=0
+3 KILL @SCRNARR
+4 SET STOP=0
+5 ;Select report
+6 DO REPORT
if STOP
QUIT
+7 ;Select division
+8 DO DIVISION
if STOP
QUIT
+9 ;Select date range
+10 DO DATES
if STOP
QUIT
+11 ;149 Section added
SET ECXPORT=$$EXPORT^ECXUTL1
if ECXPORT=-1
QUIT
IF $GET(ECXPORT)
Begin DoDot:1
+12 KILL ^TMP($JOB,"ECXPORT")
+13 SET ^TMP($JOB,"ECXPORT",0)="DIVISION^DATE^RECORD COUNT"
SET CNT=1
+14 ;tjl 166 Changed order
DO @$SELECT(REPORT=2:"GETUDATA",REPORT=1:"GETIDATA",1:"")
+15 DO DETAIL
+16 DO EXPDISP^ECXUTL1
+17 KILL ^TMP($JOB,"ECXPORT"),^TMP($JOB,"ECXPHAA")
End DoDot:1
QUIT
+18 ;Queue Report
+19 NEW ZTDESC,ZTIO,ZTSAVE
+20 FOR X="REPORT","SDATE","EDATE","STOP"
SET ZTSAVE(X)=""
+21 SET ZTSAVE("SCRNARR")=""
+22 SET TMP=$$OREF^DILF(SCRNARR)
+23 SET ZTSAVE(TMP)=""
+24 IF $DATA(@SCRNARR)#2
SET ZTSAVE(SCRNARR)=""
+25 SET ZTIO=""
+26 SET ZTDESC="DSS UDP/IVP Source Audit Report"
+27 DO EN^XUTMDEVQ("EN1^ECXPHAA",ZTDESC,.ZTSAVE)
+28 QUIT
+29 ;
EN1 ;Init variables
+1 NEW PAGE,LN,SUB
+2 SET SUB=""
SET PAGE=0
+3 DO HEADER
IF STOP
DO EXIT
QUIT
+4 ;tjl 166 Changed order
SET SUB=$SELECT(REPORT=2:"GETUDATA",REPORT=1:"GETIDATA",1:"")
+5 DO @SUB
IF STOP
DO EXIT
QUIT
+6 IF '$ORDER(^TMP($JOB,"ECXPHAA",0))
Begin DoDot:1
+7 WRITE !
+8 WRITE !,"************************************************************"
+9 WRITE !,"* NOTHING TO REPORT FOR PHARMACY "_$SELECT(REPORT=2:"UDP",REPORT=1:"IVP",1:"")_" SOURCE AUDIT REPORT *"
+10 WRITE !,"************************************************************"
+11 DO WAIT
+12 DO EXIT
End DoDot:1
QUIT
+13 DO DETAIL
IF STOP
DO EXIT
QUIT
EXIT KILL @SCRNARR
QUIT
+1 ;
REPORT ;Select report
+1 NEW DIR,DIRUT,DUOUT
+2 ;Prepare choices
+3 ;tjl 166 Changed order
SET DIR(0)="S^1:IVP;2:UDP"
+4 SET DIR("A")="Select Source Audit Report"
+5 DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DUOUT)
SET STOP=1
QUIT
+7 SET REPORT=Y
+8 QUIT
+9 ;
DIVISION ;Prompt for division
+1 ; Set Divisions into screen array (prompt is one/many/all)
+2 ;Input : SCRNARR - Screen array full global reference
+3 ;Output : 1 = OK 0 = User abort/timeout
+4 ; @SCRNARR@("DIVISION") = User pick all divisions ?
+5 ; 1 = Yes (all) 0 = No
+6 ; @SCRNARR@("DIVISION",PtrDiv) = Division name
+7 ;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
+8 ; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
+9 ; picked individual divisions (i.e. didn't pick all)
+10 ;
+11 ;Declare variables
+12 NEW VAUTD,Y,DIV,FAC
+13 ;Get division selection
+14 DO DIVISION^VAUTOMA
+15 IF Y<0
SET STOP=1
QUIT
+16 MERGE @SCRNARR@("DIVISION")=VAUTD
+17 IF VAUTD=0
Begin DoDot:1
+18 SET DIV=0
FOR
SET DIV=$ORDER(VAUTD(DIV))
if DIV'>0
QUIT
SET FAC=$$GETDIV^ECXDEPT(DIV)
SET @SCRNARR@("DIVISION",FAC)=""
End DoDot:1
+19 QUIT
+20 ;
DATES ;Prompt for start date
+1 NEW DIR,DIRUT,X,Y
+2 SET DIR(0)="D^:NOW:EX"
+3 SET DIR("A")="Enter Report Start Date"
+4 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+5 DO ^DIR
+6 IF $DATA(DIRUT)
SET STOP=1
QUIT
+7 SET SDATE=Y
+8 ;Prompt for end date
+9 KILL DIR,DIRUT,X,Y
+10 SET DIR(0)="D^:NOW:EX"
+11 SET DIR("A")="Enter Report End Date"
+12 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET STOP=1
QUIT
+15 SET EDATE=Y
+16 QUIT
+17 ;
+1 SET PAGE=$GET(PAGE)+1
SET $PIECE(LN,"=",80)=""
+2 WRITE @IOF
+3 WRITE !,$SELECT(REPORT=2:"UDP",REPORT=1:"IVP",1:"")_" Source Audit Report",?70,"PAGE: "_PAGE
+4 WRITE !!,"Run Date: "_$$FMTE^XLFDT(DT)
+5 WRITE !!,"Start Date: "_$$FMTE^XLFDT(SDATE)
+6 WRITE !,"End Date: "_$$FMTE^XLFDT(EDATE)
+7 WRITE !!,?1,"Division",?24,"Date",?39,"Record Count"
+8 WRITE !,LN
+9 QUIT
+10 ;
GETIDATA ;Get data from pharmacy IVP intermediate files
+1 ;Init variables
+2 ;161
NEW DATE,FILE,DFN,ERROR,ON,DA,ECPAT,EC,ENDATE
+3 ;161
SET DATE=SDATE-.1
SET ENDATE=EDATE+.999
SET FILE=728.113
+4 ;161
FOR
SET DATE=$ORDER(^ECX(FILE,"A",DATE))
if 'DATE!(DATE>ENDATE)
QUIT
Begin DoDot:1
+5 SET DFN=0
FOR
SET DFN=$ORDER(^ECX(FILE,"A",DATE,DFN))
if 'DFN
QUIT
Begin DoDot:2
+6 ;Filter out test patients or bad records
+7 ;patch 142--corrected to not display test patients
+8 SET ERROR=$$PAT^ECXNUT(DFN)
if ERROR
QUIT
+9 SET ON=0
FOR
SET ON=$ORDER(^ECX(FILE,"A",DATE,DFN,ON))
if 'ON
QUIT
Begin DoDot:3
+10 SET DA=0
FOR
SET DA=$ORDER(^ECX(FILE,"A",DATE,DFN,ON,DA))
if 'DA!(STOP)
QUIT
Begin DoDot:4
+11 IF $DATA(^ECX(728.113,DA,0))
SET EC=^(0)
Begin DoDot:5
+12 ;get inpatient data if exist
+13 ;161
NEW MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC
+14 NEW DIC,DIQ,DR,ECXDIC,DA
+15 ;161
SET (MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC)=""
+16 ;161 Get ward information from pharmacy order
SET WARD=$$GET1^DIQ(55.01,ON_","_DFN_",",104,"I")
+17 ;170 If ward=0, indicating an error in pharmacy, get ward at time of IV
if WARD=0
SET WARD=$$GETWARD
+18 ;161 Ward of .5 indicates outpatient
if WARD=.5
SET WARD=""
if WARD'=""
SET WARD=WARD_";"_$$GET1^DIQ(42,WARD,.015,"I")
+19 ;161
IF WARD'=""
SET DIVISION=$$GETDIV^ECXDEPT($PIECE(WARD,";",2))
+20 ;161
IF WARD=""
Begin DoDot:6
+21 ;Get division from outpatient location file 44
+22 SET CLINIC=+$PIECE(EC,U,13)
+23 ;161
SET DIC="^SC("
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR="3.5"
SET DA=CLINIC
+24 DO EN^DIQ1
+25 ;161
SET DIVISION=$$GETDIV^ECXDEPT(+$GET(ECXDIC(44,CLINIC,3.5,"I")))
+26 SET DIVISION=$SELECT(DIVISION'="":DIVISION,1:"UNKNOWN")
End DoDot:6
if STOP
QUIT
+27 ;161 Section added to get information from IV room if no ward or clinic is available
IF DIVISION="UNKNOWN"
IF $PIECE(EC,U,15)
Begin DoDot:6
+28 SET DIVISION=$$GETDIV^ECXDEPT($$PSJ59P5^ECXUTL5($PIECE(EC,U,15)))
End DoDot:6
+29 ;Save in temp global and filter division
+30 IF '@SCRNARR@("DIVISION")=1&'($DATA(@SCRNARR@("DIVISION",DIVISION)))
QUIT
+31 SET ^TMP($JOB,"ECXPHAA",$PIECE(DATE,".",1),DIVISION)=$GET(^TMP($JOB,"ECXPHAA",$PIECE(DATE,".",1),DIVISION))+1
End DoDot:5
if STOP
QUIT
End DoDot:4
if STOP
QUIT
End DoDot:3
if STOP
QUIT
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+32 QUIT
+33 ;
GETUDATA ;Get unit dose data from intermediate file 728.904
+1 ;Init variables
+2 ;149,161
NEW DATE,FILE,RECORD,DATA,DFN,ERROR,ON,WARD,DIVISION,DIC,DIQ,DR,DA,ECPAT,CLINIC,COUNT,L,ECXDIC,ENDATE
+3 ;161
SET DATE=SDATE-.1
SET ENDATE=EDATE+.999
SET STOP=0
+4 SET FILE=728.904
+5 ;161
FOR
SET DATE=$ORDER(^ECX(FILE,"A",DATE))
if 'DATE!(DATE>ENDATE)
QUIT
Begin DoDot:1
+6 SET RECORD=0
FOR
SET RECORD=$ORDER(^ECX(FILE,"A",DATE,RECORD))
if 'RECORD
QUIT
Begin DoDot:2
+7 SET DATA=$GET(^ECX(FILE,RECORD,0))
SET DFN=$PIECE(DATA,U,2)
+8 ;Filter out test patients or bad records
+9 ;patch 142-corrected to not display test patients
+10 SET ERROR=$$PAT^ECXNUT(DFN)
if ERROR
QUIT
+11 SET ON=$PIECE(DATA,U,10)
SET WARD=$PIECE(DATA,U,6)
+12 SET DIVISION=$$GETDIV^ECXDEPT($PIECE($GET(^DIC(42,+WARD,0)),U,11))
+13 ;161
IF WARD=""&(ON)
Begin DoDot:3
+14 ;Get division from outpatient location from file 44
+15 SET DIC=55
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR="62"
SET DR(55.06)="130"
SET DA=DFN
+16 SET DA(55.06)=+ON
DO EN^DIQ1
+17 ;161
SET CLINIC=+$GET(ECXDIC(55.06,+ON,130,"I"))
+18 ;161
SET DIC="^SC("
SET DIQ(0)="I"
SET DIQ="ECXDIC"
SET DR=3.5
SET DA=CLINIC
DO EN^DIQ1
+19 ;161
SET DIVISION=$$GETDIV^ECXDEPT(+$GET(ECXDIC(44,CLINIC,3.5,"I")))
+20 ;161
SET DIVISION=$SELECT(DIVISION'="":DIVISION,1:"UNKNOWN")
KILL ECXDIC
End DoDot:3
if STOP
QUIT
+21 ;Save in temp global and filter division
+22 IF '@SCRNARR@("DIVISION")=1&'($DATA(@SCRNARR@("DIVISION",DIVISION)))
QUIT
+23 SET ^TMP($JOB,"ECXPHAA",$PIECE(DATE,".",1),DIVISION)=$GET(^TMP($JOB,"ECXPHAA",$PIECE(DATE,".",1),DIVISION))+1
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+24 QUIT
+25 ;
DETAIL ;Print report
+1 ;Init variables
+2 ;149
NEW DATE,DIV,COUNT
+3 ;149
SET (DATE,COUNT)=0
SET DIV=""
+4 ;149
FOR
SET DATE=$ORDER(^TMP($JOB,"ECXPHAA",DATE))
if 'DATE!(STOP)
QUIT
FOR
SET DIV=$ORDER(^TMP($JOB,"ECXPHAA",DATE,DIV))
if DIV=""!(STOP)
QUIT
SET COUNT=^(DIV)
Begin DoDot:1
+5 ;149
IF $GET(ECXPORT)
SET ^TMP($JOB,"ECXPORT",CNT)=DIV_U_$$FMTE^XLFDT(DATE)_U_COUNT
SET CNT=CNT+1
QUIT
+6 ;149
WRITE !,?1,DIV,?20,$$FMTE^XLFDT(DATE),?45,COUNT
IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:1
+7 QUIT
+8 ;
WAIT ;End of page logic
+1 ;Input ; None
+2 ;Output ; STOP - Flag indicating if printing should continue
+3 ; 1 = Stop 0 = Continue
+4 ;
+5 SET STOP=0
+6 ;CRT - Prompt for continue
+7 IF $EXTRACT(IOST,1,2)="C-"&(IOSL'>24)
Begin DoDot:1
+8 FOR
if $Y>(IOSL-3)
QUIT
WRITE !
+9 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 SET STOP=$SELECT(Y'=1:1,1:0)
End DoDot:1
QUIT
+13 ;Background task - check taskman
+14 SET STOP=$$S^%ZTLOAD()
+15 IF STOP
Begin DoDot:1
+16 WRITE !,"*********************************************"
+17 WRITE !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
+18 WRITE !,"*********************************************"
End DoDot:1
+19 QUIT
+20 ;
GETWARD() ;170 Section added to find ward at time of IV when ward is incorrectly set to 0 in pharmacy
+1 ;Ward on d/t
NEW EVDT,VAIP,WARDODT
+2 ;Get IV date/time
SET EVDT=$PIECE(EC,U,5)
+3 SET VAIP("D")=EVDT
+4 ;Get inpt information
DO IN5^VADPT
+5 ;IEN of ward
SET WARDODT=$PIECE(VAIP(5),U)
+6 ;If ward not found, set it to null
if '+WARDODT
SET WARDODT=""
+7 QUIT WARDODT
