ECXPHAI ;MBS/BAH - Pharmacy DSS Extract IV Holding File Report ;3/5/24 11:53
;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36
;
EN ;entry point from option
N STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT,TXTYPE,ECXPAT,ECRUN,DATE,Y
S STOP=0
; get today's date
D NOW^%DTC S DATE=X,Y=$E(%,1,12) D DD^%DT S ECRUN=Y K %DT
;Select transaction type
D TXTYPE Q:STOP
;Select date range
D DATES Q:STOP
;Select patient
D PATIENT Q:STOP
S ECXPORT=$$EXPORT^ECXUTL1 Q:ECXPORT=-1 I $G(ECXPORT) D Q
.K ^TMP($J,"ECXPORT")
.S ^TMP($J,"ECXPORT",0)="TRANSACTION TYPE^ORDER NUMBER^ORDER DATE^DRUG^DATE/TIME^ADDITIVE STRENGTH^ADDITIVE STRENGTH UNITS^SOLUTION VOLUME^COST^PATIENT",CNT=0
.D GETDATA
.D DETAIL
.D EXPDISP^ECXUTL1
.K ^TMP($J,"ECXPORT"),^TMP($J,"ECXPHAI")
;Queue Report
N ZTDESC,ZTIO,ZTSAVE
F X="TXTYPE","SDATE","EDATE","ECRUN","ECXPAT","STOP" S ZTSAVE(X)=""
S ZTIO=""
S ZTDESC="DSS Extract IV Holding File Report"
W !!,"This report requires 132 column format."
D EN^XUTMDEVQ("EN1^ECXPHAI",ZTDESC,.ZTSAVE)
Q
;
EN1 ;Init variables
N PAGE,LN
S PAGE=0
D HEADER I STOP D EXIT Q
D GETDATA I STOP D EXIT Q
I '$O(^TMP($J,"ECXPHAI",0)) D Q
.W !
.W !,"************************************************************"
.W !,"* NOTHING TO REPORT FOR IV HOLDING FILE REPORT *"
.W !,"************************************************************"
.D WAIT
.D EXIT
D DETAIL I STOP D EXIT Q
EXIT Q
;
TXTYPE ;Prompt for transaction type
; This code will pull the options from the file #728.113 field #5 DD to ensure compatibility
; in case of any future change to that field.
N DDTYPES,DIR,X,Y
D FIELD^DID(728.113,5,,"SET OF CODES","DDTYPES")
S DIR(0)="S"_U_DDTYPES("SET OF CODES")_"A:ALL"
S DIR("A")="Select Transaction Type"
S DIR("B")="A"
D ^DIR
I $D(DIRUT) S STOP=1 Q
S TXTYPE=+Y
Q
;
DATES ;Prompt for start date
N DIR,DIRUT,X,Y
W !!,"Note that the start and end dates for the IV Holding File Report refer to the",!,"DATE/TIME field, not the ORDER DATE field."
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
;
PATIENT ;Prompt for patient
N DIC
S ECXPAT=0
S DIC=2,DIC(0)="AME",DIC("A")="Select PATIENT (to run for all patients, leave blank):"
D ^DIC
S:Y>0 ECXPAT=+Y
Q
;
S PAGE=$G(PAGE)+1,$P(LN,"=",132)=""
W @IOF
W !,"IV Holding File Report",?121,$$RJ^XLFSTR("PAGE: "_PAGE,10)
W !,"Start Date: "_$$FMTE^XLFDT(SDATE),?90,"Report Run Date/Time: "_ECRUN
W !,"End Date: "_$$FMTE^XLFDT(EDATE),!
W !,"Transaction Type Date/Time Order Number Order Date Patient"
W !," Drug Additive Strength Additive Strength Units Solution Volume Cost"
W !,LN
Q
;
GETDATA ;Get data from IV Holding File
N DATE,FILE,DFN,ERROR,ENDATE,ECDATA,DTEI,DA,ON
S DATE=SDATE-.1,ENDATE=EDATE+.999,FILE=728.113
K ^TMP($J,"ECXPHAI")
S DTEI=$S(ECXPORT:"I",1:"E")
F S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>ENDATE) D Q:STOP
.S DFN=0 F S DFN=$O(^ECX(FILE,"A",DATE,DFN)) Q:'DFN D Q:STOP
..;If user selected a patient to filter for, ensure only those records go through
..Q:+$G(ECXPAT)&(DFN'=$G(ECXPAT))
..;Filter out test patients or bad records
..N ECXPAT ;Have to new here b/c it's being killed in the below call for some reason
..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 D Q:STOP
....N ECPAT,X,ECPNAM
....Q:TXTYPE'="0"&($$GET1^DIQ(FILE,DA_",",5,"I")'=TXTYPE)
....K ECDATA D GETS^DIQ(FILE,DA_",","*","EI","ECDATA") Q:'$D(ECDATA)
....S ECDATA="ECDATA("_FILE_","""_DA_","")"
....S X=$$PAT^ECXUTL3(DFN,"","1",.ECPAT)
....S ECPNAM=$E($G(ECPAT("NAME")))_$E($G(ECPAT("SSN")),6,9)
....;Trans. Type^Order Number^Order Date^Drug^Date/Time^Add. Str^Add. Str. Units^Sol Vol^Cost^Patient
....;S ^TMP($J,"ECXPHAI",DATE,DA)=@ECDATA@(5,"E")_U_ON_U_@ECDATA@(14,DTEI)_U_@ECDATA@(3,"E")_U_@ECDATA@(4,DTEI)_U_@ECDATA@(6,"E")_U_@ECDATA@(7,"E")_U_@ECDATA@(8,"E")_U_@ECDATA@(12,"E")_U_ECPNAM
....S ^TMP($J,"ECXPHAI",DATE,DA)=@ECDATA@(5,"E")_U_ON_U_$$FMTE^XLFDT(@ECDATA@(14,"I"),"2Z")_U_@ECDATA@(3,"E")_U_$$FMTE^XLFDT(@ECDATA@(4,"I"),"2Z")_U_@ECDATA@(6,"E")_U_@ECDATA@(7,"E")_U_@ECDATA@(8,"E")_U_@ECDATA@(12,"E")_U_ECPNAM
Q
;
DETAIL ;Print report
N CUR
S CUR=$NA(^TMP($J,"ECXPHAI"))
F S CUR=$Q(@CUR) Q:$QS(CUR,2)'="ECXPHAI" D Q:STOP
.I $G(ECXPORT) D Q
..S CNT=$G(CNT)+1,^TMP($J,"ECXPORT",CNT)=@CUR
..;S $P(^TMP($J,"ECXPORT",CNT),U,3)=$$FMTE^XLFDT($P(^TMP($J,"ECXPORT",CNT),U,3),2)
..;S $P(^TMP($J,"ECXPORT",CNT),U,5)=$$FMTE^XLFDT($P(^TMP($J,"ECXPORT",CNT),U,5),2)
.W !,$P(@CUR,U),?18,$P(@CUR,U,5),?41,$P(@CUR,U,2),?55,$P(@CUR,U,3),?73,$P(@CUR,U,10)
.W !,?1,$P(@CUR,U,4),?43,$P(@CUR,U,6),?64,$P(@CUR,U,7),?90,$P(@CUR,U,8),?110,$P(@CUR,U,9),!
.I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
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-" 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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECXPHAI 5831 printed Nov 22, 2024@17:03:33 Page 2
ECXPHAI ;MBS/BAH - Pharmacy DSS Extract IV Holding File Report ;3/5/24 11:53
+1 ;;3.0;DSS EXTRACTS;**190**;Dec 22, 1997;Build 36
+2 ;
EN ;entry point from option
+1 NEW STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP,ECXPORT,CNT,TXTYPE,ECXPAT,ECRUN,DATE,Y
+2 SET STOP=0
+3 ; get today's date
+4 DO NOW^%DTC
SET DATE=X
SET Y=$EXTRACT(%,1,12)
DO DD^%DT
SET ECRUN=Y
KILL %DT
+5 ;Select transaction type
+6 DO TXTYPE
if STOP
QUIT
+7 ;Select date range
+8 DO DATES
if STOP
QUIT
+9 ;Select patient
+10 DO PATIENT
if STOP
QUIT
+11 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)="TRANSACTION TYPE^ORDER NUMBER^ORDER DATE^DRUG^DATE/TIME^ADDITIVE STRENGTH^ADDITIVE STRENGTH UNITS^SOLUTION VOLUME^COST^PATIENT"
SET CNT=0
+14 DO GETDATA
+15 DO DETAIL
+16 DO EXPDISP^ECXUTL1
+17 KILL ^TMP($JOB,"ECXPORT"),^TMP($JOB,"ECXPHAI")
End DoDot:1
QUIT
+18 ;Queue Report
+19 NEW ZTDESC,ZTIO,ZTSAVE
+20 FOR X="TXTYPE","SDATE","EDATE","ECRUN","ECXPAT","STOP"
SET ZTSAVE(X)=""
+21 SET ZTIO=""
+22 SET ZTDESC="DSS Extract IV Holding File Report"
+23 WRITE !!,"This report requires 132 column format."
+24 DO EN^XUTMDEVQ("EN1^ECXPHAI",ZTDESC,.ZTSAVE)
+25 QUIT
+26 ;
EN1 ;Init variables
+1 NEW PAGE,LN
+2 SET PAGE=0
+3 DO HEADER
IF STOP
DO EXIT
QUIT
+4 DO GETDATA
IF STOP
DO EXIT
QUIT
+5 IF '$ORDER(^TMP($JOB,"ECXPHAI",0))
Begin DoDot:1
+6 WRITE !
+7 WRITE !,"************************************************************"
+8 WRITE !,"* NOTHING TO REPORT FOR IV HOLDING FILE REPORT *"
+9 WRITE !,"************************************************************"
+10 DO WAIT
+11 DO EXIT
End DoDot:1
QUIT
+12 DO DETAIL
IF STOP
DO EXIT
QUIT
EXIT QUIT
+1 ;
TXTYPE ;Prompt for transaction type
+1 ; This code will pull the options from the file #728.113 field #5 DD to ensure compatibility
+2 ; in case of any future change to that field.
+3 NEW DDTYPES,DIR,X,Y
+4 DO FIELD^DID(728.113,5,,"SET OF CODES","DDTYPES")
+5 SET DIR(0)="S"_U_DDTYPES("SET OF CODES")_"A:ALL"
+6 SET DIR("A")="Select Transaction Type"
+7 SET DIR("B")="A"
+8 DO ^DIR
+9 IF $DATA(DIRUT)
SET STOP=1
QUIT
+10 SET TXTYPE=+Y
+11 QUIT
+12 ;
DATES ;Prompt for start date
+1 NEW DIR,DIRUT,X,Y
+2 WRITE !!,"Note that the start and end dates for the IV Holding File Report refer to the",!,"DATE/TIME field, not the ORDER DATE field."
+3 SET DIR(0)="D^:NOW:EX"
+4 SET DIR("A")="Enter Report Start Date"
+5 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET STOP=1
QUIT
+8 SET SDATE=Y
+9 ;Prompt for end date
+10 KILL DIR,DIRUT,X,Y
+11 SET DIR(0)="D^:NOW:EX"
+12 SET DIR("A")="Enter Report End Date"
+13 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
+14 DO ^DIR
+15 IF $DATA(DIRUT)
SET STOP=1
QUIT
+16 SET EDATE=Y
+17 QUIT
+18 ;
PATIENT ;Prompt for patient
+1 NEW DIC
+2 SET ECXPAT=0
+3 SET DIC=2
SET DIC(0)="AME"
SET DIC("A")="Select PATIENT (to run for all patients, leave blank):"
+4 DO ^DIC
+5 if Y>0
SET ECXPAT=+Y
+6 QUIT
+7 ;
+1 SET PAGE=$GET(PAGE)+1
SET $PIECE(LN,"=",132)=""
+2 WRITE @IOF
+3 WRITE !,"IV Holding File Report",?121,$$RJ^XLFSTR("PAGE: "_PAGE,10)
+4 WRITE !,"Start Date: "_$$FMTE^XLFDT(SDATE),?90,"Report Run Date/Time: "_ECRUN
+5 WRITE !,"End Date: "_$$FMTE^XLFDT(EDATE),!
+6 WRITE !,"Transaction Type Date/Time Order Number Order Date Patient"
+7 WRITE !," Drug Additive Strength Additive Strength Units Solution Volume Cost"
+8 WRITE !,LN
+9 QUIT
+10 ;
GETDATA ;Get data from IV Holding File
+1 NEW DATE,FILE,DFN,ERROR,ENDATE,ECDATA,DTEI,DA,ON
+2 SET DATE=SDATE-.1
SET ENDATE=EDATE+.999
SET FILE=728.113
+3 KILL ^TMP($JOB,"ECXPHAI")
+4 SET DTEI=$SELECT(ECXPORT:"I",1:"E")
+5 FOR
SET DATE=$ORDER(^ECX(FILE,"A",DATE))
if 'DATE!(DATE>ENDATE)
QUIT
Begin DoDot:1
+6 SET DFN=0
FOR
SET DFN=$ORDER(^ECX(FILE,"A",DATE,DFN))
if 'DFN
QUIT
Begin DoDot:2
+7 ;If user selected a patient to filter for, ensure only those records go through
+8 if +$GET(ECXPAT)&(DFN'=$GET(ECXPAT))
QUIT
+9 ;Filter out test patients or bad records
+10 ;Have to new here b/c it's being killed in the below call for some reason
NEW ECXPAT
+11 SET ERROR=$$PAT^ECXNUT(DFN)
if ERROR
QUIT
+12 SET ON=0
FOR
SET ON=$ORDER(^ECX(FILE,"A",DATE,DFN,ON))
if 'ON
QUIT
Begin DoDot:3
+13 SET DA=0
FOR
SET DA=$ORDER(^ECX(FILE,"A",DATE,DFN,ON,DA))
if 'DA
QUIT
Begin DoDot:4
+14 NEW ECPAT,X,ECPNAM
+15 if TXTYPE'="0"&($$GET1^DIQ(FILE,DA_",",5,"I")'=TXTYPE)
QUIT
+16 KILL ECDATA
DO GETS^DIQ(FILE,DA_",","*","EI","ECDATA")
if '$DATA(ECDATA)
QUIT
+17 SET ECDATA="ECDATA("_FILE_","""_DA_","")"
+18 SET X=$$PAT^ECXUTL3(DFN,"","1",.ECPAT)
+19 SET ECPNAM=$EXTRACT($GET(ECPAT("NAME")))_$EXTRACT($GET(ECPAT("SSN")),6,9)
+20 ;Trans. Type^Order Number^Order Date^Drug^Date/Time^Add. Str^Add. Str. Units^Sol Vol^Cost^Patient
+21 ;S ^TMP($J,"ECXPHAI",DATE,DA)=@ECDATA@(5,"E")_U_ON_U_@ECDATA@(14,DTEI)_U_@ECDATA@(3,"E")_U_@ECDATA@(4,DTEI)_U_@ECDATA@(6,"E")_U_@ECDATA@(7,"E")_U_@ECDATA@(8,"E")_U_@ECDATA@(12,"E")_U_ECPNAM
+22 SET ^TMP($JOB,"ECXPHAI",DATE,DA)=@ECDATA@(5,"E")_U_ON_U_$$FMTE^XLFDT(@ECDATA@(14,"I"),"2Z")_U_@ECDATA@(3,"E")_U_$$FMTE^XLFDT(@ECDATA@(4,"I"),"2Z")_U_@ECDATA@(6,"E")_U_@ECDATA@(7,"E")_U_@ECDATA@(8,"E")_U_@ECDATA@(
12,"E")_U_ECPNAM
End DoDot:4
if STOP
QUIT
End DoDot:3
if STOP
QUIT
End DoDot:2
if STOP
QUIT
End DoDot:1
if STOP
QUIT
+23 QUIT
+24 ;
DETAIL ;Print report
+1 NEW CUR
+2 SET CUR=$NAME(^TMP($JOB,"ECXPHAI"))
+3 FOR
SET CUR=$QUERY(@CUR)
if $QSUBSCRIPT(CUR,2)'="ECXPHAI"
QUIT
Begin DoDot:1
+4 IF $GET(ECXPORT)
Begin DoDot:2
+5 SET CNT=$GET(CNT)+1
SET ^TMP($JOB,"ECXPORT",CNT)=@CUR
+6 ;S $P(^TMP($J,"ECXPORT",CNT),U,3)=$$FMTE^XLFDT($P(^TMP($J,"ECXPORT",CNT),U,3),2)
+7 ;S $P(^TMP($J,"ECXPORT",CNT),U,5)=$$FMTE^XLFDT($P(^TMP($J,"ECXPORT",CNT),U,5),2)
End DoDot:2
QUIT
+8 WRITE !,$PIECE(@CUR,U),?18,$PIECE(@CUR,U,5),?41,$PIECE(@CUR,U,2),?55,$PIECE(@CUR,U,3),?73,$PIECE(@CUR,U,10)
+9 WRITE !,?1,$PIECE(@CUR,U,4),?43,$PIECE(@CUR,U,6),?64,$PIECE(@CUR,U,7),?90,$PIECE(@CUR,U,8),?110,$PIECE(@CUR,U,9),!
+10 IF $Y>(IOSL-5)
DO WAIT
if STOP
QUIT
DO HEADER
End DoDot:1
if STOP
QUIT
+11 QUIT
+12 ;
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-"
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
