source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECXPHAA.m@ 861

ECXPHAA ;ALB/JRC Pharmacy DSS Extract UDP/IVP Source Audit Report ; 11/2/06 8:54am

 ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30

 ;

EN ;entry point from option

 N SCRNARR,STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP

 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

 ;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=1:"GETUDATA",REPORT=2:"GETIDATA",1:"")

 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=1:"UDP",REPORT=2:"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:UDP;2:IVP"

 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

 ;

HEADER ;Print header

 S PAGE=$G(PAGE)+1,$P(LN,"=",80)=""

 W @IOF

 W !,$S(REPORT=1:"UDP",REPORT=2:"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

 S DATE=SDATE-.1,EDATE=EDATE+.999,FILE=728.113

 F  S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>EDATE)  D  Q:STOP

 .S DFN=0 F  S DFN=$O(^ECX(FILE,"A",DATE,DFN)) Q:'DFN  D  Q:STOP

 ..;Filter out test patients or bad records

 ..S ERROR=0 D 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 X,STATUS,MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC

 .....N DIC,DIQ,DR,ECXDIC,DA

 .....S (X,STATUS,MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC)=""

 .....S X=$$INP^ECXUTL2(DFN,DATE),STATUS=$P(X,U,1)

 .....I STATUS="I" D  Q:STOP

 ......S WARD=$P(X,U,9),DIVISION=$$GETDIV^ECXDEPT($P(WARD,";",2))

 .....I STATUS="O" D  Q:STOP

 ......;Get division from  outpatient location file 44

 ......S CLINIC=+$P(EC,U,13)

 ......S DIC="^SC(",DIQ(0)="I",DIQ="ECXDIC",DR="3",DA=CLINIC

 ......D EN^DIQ1

 ......S DIVISION=$$RADDIV^ECXDEPT(+$G(ECXDIC(44,CLINIC,3,"I")))

 ......S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN")

 .....;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,X,STATUS,DIC,DIQ,DR,DA,ECPAT,CLINIC,CNT,FACILITY,L

 S DATE=SDATE-.1,EDATE=EDATE+.999,STOP=0

 S FILE=728.904

 F  S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>EDATE)  D  Q:STOP

 .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

 ..S ERROR=0 D 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))

 ..S FACILITY=$P($G(^DIC(42,+WARD,0)),U,11)

 ..S X=$$INP^ECXUTL2(DFN,DATE),STATUS=$P(X,U,1)

 ..I STATUS="O"&(ON) D  Q:STOP

 ...;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,DFN,130,"I"))

 ...S DIVISION=$$RADDIV^ECXDEPT($G(ECXDIC(44,CLINIC,3,"I")))

 ...S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN")

 ..;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,CNT

 S (DATE,CNT)=0,DIV=""

 F  S DATE=$O(^TMP($J,"ECXPHAA",DATE)) Q:'DATE!(STOP)  F  S DIV=$O(^TMP($J,"ECXPHAA",DATE,DIV)) Q:DIV=""  S CNT=^(DIV) W !,?1,DIV,?20,$$FMTE^XLFDT(DATE),?45,CNT 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-"&(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