ECXPHAI.m

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

 ;

HEADER ;Print header

 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 ---ECXPHAI   5831     printed  Mar 13, 2025@20:58:03                                                                                                                                                                                                     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       ;

HEADER    ;Print header

 +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