| [613] | 1 | ECXPHAA ;ALB/JRC Pharmacy DSS Extract UDP/IVP Source Audit Report ; 11/2/06 8:54am
|
|---|
| 2 | ;;3.0;DSS EXTRACTS;**92**;Dec 22, 1997;Build 30
|
|---|
| 3 | ;
|
|---|
| 4 | EN ;entry point from option
|
|---|
| 5 | N SCRNARR,STOP,REPORT,DIVISION,SDATE,EDATE,X,TMP
|
|---|
| 6 | S SCRNARR="^TMP($J,""ECXPHAA"")",STOP=0
|
|---|
| 7 | K @SCRNARR
|
|---|
| 8 | S STOP=0
|
|---|
| 9 | ;Select report
|
|---|
| 10 | D REPORT Q:STOP
|
|---|
| 11 | ;Select division
|
|---|
| 12 | D DIVISION Q:STOP
|
|---|
| 13 | ;Select date range
|
|---|
| 14 | D DATES Q:STOP
|
|---|
| 15 | ;Queue Report
|
|---|
| 16 | N ZTDESC,ZTIO,ZTSAVE
|
|---|
| 17 | F X="REPORT","SDATE","EDATE","STOP" S ZTSAVE(X)=""
|
|---|
| 18 | S ZTSAVE("SCRNARR")=""
|
|---|
| 19 | S TMP=$$OREF^DILF(SCRNARR)
|
|---|
| 20 | S ZTSAVE(TMP)=""
|
|---|
| 21 | I $D(@SCRNARR)#2 S ZTSAVE(SCRNARR)=""
|
|---|
| 22 | S ZTIO=""
|
|---|
| 23 | S ZTDESC="DSS UDP/IVP Source Audit Report"
|
|---|
| 24 | D EN^XUTMDEVQ("EN1^ECXPHAA",ZTDESC,.ZTSAVE)
|
|---|
| 25 | Q
|
|---|
| 26 | ;
|
|---|
| 27 | EN1 ;Init variables
|
|---|
| 28 | N PAGE,LN,SUB
|
|---|
| 29 | S SUB="",PAGE=0
|
|---|
| 30 | D HEADER I STOP D EXIT Q
|
|---|
| 31 | S SUB=$S(REPORT=1:"GETUDATA",REPORT=2:"GETIDATA",1:"")
|
|---|
| 32 | D @SUB I STOP D EXIT Q
|
|---|
| 33 | I '$O(^TMP($J,"ECXPHAA",0)) D Q
|
|---|
| 34 | .W !
|
|---|
| 35 | .W !,"************************************************************"
|
|---|
| 36 | .W !,"* NOTHING TO REPORT FOR PHARMACY "_$S(REPORT=1:"UDP",REPORT=2:"IVP",1:"")_" SOURCE AUDIT REPORT *"
|
|---|
| 37 | .W !,"************************************************************"
|
|---|
| 38 | .D WAIT
|
|---|
| 39 | .D EXIT
|
|---|
| 40 | D DETAIL I STOP D EXIT Q
|
|---|
| 41 | EXIT K @SCRNARR Q
|
|---|
| 42 | ;
|
|---|
| 43 | REPORT ;Select report
|
|---|
| 44 | N DIR,DIRUT,DUOUT
|
|---|
| 45 | ;Prepare choices
|
|---|
| 46 | S DIR(0)="S^1:UDP;2:IVP"
|
|---|
| 47 | S DIR("A")="Select Source Audit Report"
|
|---|
| 48 | D ^DIR
|
|---|
| 49 | I $D(DIRUT)!$D(DUOUT) S STOP=1 Q
|
|---|
| 50 | S REPORT=Y
|
|---|
| 51 | Q
|
|---|
| 52 | ;
|
|---|
| 53 | DIVISION ;Prompt for division
|
|---|
| 54 | ; Set Divisions into screen array (prompt is one/many/all)
|
|---|
| 55 | ;Input : SCRNARR - Screen array full global reference
|
|---|
| 56 | ;Output : 1 = OK 0 = User abort/timeout
|
|---|
| 57 | ; @SCRNARR@("DIVISION") = User pick all divisions ?
|
|---|
| 58 | ; 1 = Yes (all) 0 = No
|
|---|
| 59 | ; @SCRNARR@("DIVISION",PtrDiv) = Division name
|
|---|
| 60 | ;Note : @SCRNARR@("DIVISION") is initialized (KILLed) on input
|
|---|
| 61 | ; : @SCRNARR@("DIVISION",PtrDiv) is only set when the user
|
|---|
| 62 | ; picked individual divisions (i.e. didn't pick all)
|
|---|
| 63 | ;
|
|---|
| 64 | ;Declare variables
|
|---|
| 65 | N VAUTD,Y,DIV,FAC
|
|---|
| 66 | ;Get division selection
|
|---|
| 67 | D DIVISION^VAUTOMA
|
|---|
| 68 | I Y<0 S STOP=1 Q
|
|---|
| 69 | M @SCRNARR@("DIVISION")=VAUTD
|
|---|
| 70 | I VAUTD=0 D
|
|---|
| 71 | .S DIV=0 F S DIV=$O(VAUTD(DIV)) Q:DIV'>0 S FAC=$$GETDIV^ECXDEPT(DIV) S @SCRNARR@("DIVISION",FAC)=""
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | DATES ;Prompt for start date
|
|---|
| 75 | N DIR,DIRUT,X,Y
|
|---|
| 76 | S DIR(0)="D^:NOW:EX"
|
|---|
| 77 | S DIR("A")="Enter Report Start Date"
|
|---|
| 78 | S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
|
|---|
| 79 | D ^DIR
|
|---|
| 80 | I $D(DIRUT) S STOP=1 Q
|
|---|
| 81 | S SDATE=Y
|
|---|
| 82 | ;Prompt for end date
|
|---|
| 83 | K DIR,DIRUT,X,Y
|
|---|
| 84 | S DIR(0)="D^:NOW:EX"
|
|---|
| 85 | S DIR("A")="Enter Report End Date"
|
|---|
| 86 | S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT,"1D")
|
|---|
| 87 | D ^DIR
|
|---|
| 88 | I $D(DIRUT) S STOP=1 Q
|
|---|
| 89 | S EDATE=Y
|
|---|
| 90 | Q
|
|---|
| 91 | ;
|
|---|
| 92 | HEADER ;Print header
|
|---|
| 93 | S PAGE=$G(PAGE)+1,$P(LN,"=",80)=""
|
|---|
| 94 | W @IOF
|
|---|
| 95 | W !,$S(REPORT=1:"UDP",REPORT=2:"IVP",1:"")_" Source Audit Report",?70,"PAGE: "_PAGE
|
|---|
| 96 | W !!,"Run Date: "_$$FMTE^XLFDT(DT)
|
|---|
| 97 | W !!,"Start Date: "_$$FMTE^XLFDT(SDATE)
|
|---|
| 98 | W !,"End Date: "_$$FMTE^XLFDT(EDATE)
|
|---|
| 99 | W !!,?1,"Division",?24,"Date",?39,"Record Count"
|
|---|
| 100 | W !,LN
|
|---|
| 101 | Q
|
|---|
| 102 | ;
|
|---|
| 103 | GETIDATA ;Get data from pharmacy IVP intermediate files
|
|---|
| 104 | ;Init variables
|
|---|
| 105 | N DATE,FILE,DFN,ERROR,ON,DA,ECPAT,EC
|
|---|
| 106 | S DATE=SDATE-.1,EDATE=EDATE+.999,FILE=728.113
|
|---|
| 107 | F S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>EDATE) D Q:STOP
|
|---|
| 108 | .S DFN=0 F S DFN=$O(^ECX(FILE,"A",DATE,DFN)) Q:'DFN D Q:STOP
|
|---|
| 109 | ..;Filter out test patients or bad records
|
|---|
| 110 | ..S ERROR=0 D PAT^ECXNUT(DFN) Q:ERROR
|
|---|
| 111 | ..S ON=0 F S ON=$O(^ECX(FILE,"A",DATE,DFN,ON)) Q:'ON D Q:STOP
|
|---|
| 112 | ...S DA=0 F S DA=$O(^ECX(FILE,"A",DATE,DFN,ON,DA)) Q:'DA!(STOP) D Q:STOP
|
|---|
| 113 | ....I $D(^ECX(728.113,DA,0)) S EC=^(0) D Q:STOP
|
|---|
| 114 | .....;get inpatient data if exist
|
|---|
| 115 | .....N X,STATUS,MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC
|
|---|
| 116 | .....N DIC,DIQ,DR,ECXDIC,DA
|
|---|
| 117 | .....S (X,STATUS,MOVEMENT,ADMIT,SPECIAL,WARD,DIVISION,CLINIC)=""
|
|---|
| 118 | .....S X=$$INP^ECXUTL2(DFN,DATE),STATUS=$P(X,U,1)
|
|---|
| 119 | .....I STATUS="I" D Q:STOP
|
|---|
| 120 | ......S WARD=$P(X,U,9),DIVISION=$$GETDIV^ECXDEPT($P(WARD,";",2))
|
|---|
| 121 | .....I STATUS="O" D Q:STOP
|
|---|
| 122 | ......;Get division from outpatient location file 44
|
|---|
| 123 | ......S CLINIC=+$P(EC,U,13)
|
|---|
| 124 | ......S DIC="^SC(",DIQ(0)="I",DIQ="ECXDIC",DR="3",DA=CLINIC
|
|---|
| 125 | ......D EN^DIQ1
|
|---|
| 126 | ......S DIVISION=$$RADDIV^ECXDEPT(+$G(ECXDIC(44,CLINIC,3,"I")))
|
|---|
| 127 | ......S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN")
|
|---|
| 128 | .....;Save in temp global and filter division
|
|---|
| 129 | .....I '@SCRNARR@("DIVISION")=1&'($D(@SCRNARR@("DIVISION",DIVISION))) Q
|
|---|
| 130 | .....S ^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION)=$G(^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION))+1
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | GETUDATA ;Get unit dose data from intermediate file 728.904
|
|---|
| 134 | ;Init variables
|
|---|
| 135 | N DATE,FILE,RECORD,DATA,DFN,ERROR,ON,WARD,DIVISION,X,STATUS,DIC,DIQ,DR,DA,ECPAT,CLINIC,CNT,FACILITY,L
|
|---|
| 136 | S DATE=SDATE-.1,EDATE=EDATE+.999,STOP=0
|
|---|
| 137 | S FILE=728.904
|
|---|
| 138 | F S DATE=$O(^ECX(FILE,"A",DATE)) Q:'DATE!(DATE>EDATE) D Q:STOP
|
|---|
| 139 | .S RECORD=0 F S RECORD=$O(^ECX(FILE,"A",DATE,RECORD)) Q:'RECORD D Q:STOP
|
|---|
| 140 | ..S DATA=$G(^ECX(FILE,RECORD,0)),DFN=$P(DATA,U,2)
|
|---|
| 141 | ..;Filter out test patients or bad records
|
|---|
| 142 | ..S ERROR=0 D PAT^ECXNUT(DFN) Q:ERROR
|
|---|
| 143 | ..S ON=$P(DATA,U,10),WARD=$P(DATA,U,6)
|
|---|
| 144 | ..S DIVISION=$$GETDIV^ECXDEPT($P($G(^DIC(42,+WARD,0)),U,11))
|
|---|
| 145 | ..S FACILITY=$P($G(^DIC(42,+WARD,0)),U,11)
|
|---|
| 146 | ..S X=$$INP^ECXUTL2(DFN,DATE),STATUS=$P(X,U,1)
|
|---|
| 147 | ..I STATUS="O"&(ON) D Q:STOP
|
|---|
| 148 | ...;Get division from outpatient location from file 44
|
|---|
| 149 | ...S DIC=55,DIQ(0)="I",DIQ="ECXDIC",DR="62",DR(55.06)="130",DA=DFN
|
|---|
| 150 | ...S DA(55.06)=+ON D EN^DIQ1
|
|---|
| 151 | ...S CLINIC=+$G(ECXDIC(55.06,DFN,130,"I"))
|
|---|
| 152 | ...S DIVISION=$$RADDIV^ECXDEPT($G(ECXDIC(44,CLINIC,3,"I")))
|
|---|
| 153 | ...S DIVISION=$S(DIVISION'="":DIVISION,1:"UNKNOWN")
|
|---|
| 154 | ..;Save in temp global and filter division
|
|---|
| 155 | ..I '@SCRNARR@("DIVISION")=1&'($D(@SCRNARR@("DIVISION",DIVISION))) Q
|
|---|
| 156 | ..S ^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION)=$G(^TMP($J,"ECXPHAA",$P(DATE,".",1),DIVISION))+1
|
|---|
| 157 | Q
|
|---|
| 158 | ;
|
|---|
| 159 | DETAIL ;Print report
|
|---|
| 160 | ;Init variables
|
|---|
| 161 | N DATE,DIV,CNT
|
|---|
| 162 | S (DATE,CNT)=0,DIV=""
|
|---|
| 163 | 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
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | WAIT ;End of page logic
|
|---|
| 167 | ;Input ; None
|
|---|
| 168 | ;Output ; STOP - Flag indicating if printing should continue
|
|---|
| 169 | ; 1 = Stop 0 = Continue
|
|---|
| 170 | ;
|
|---|
| 171 | S STOP=0
|
|---|
| 172 | ;CRT - Prompt for continue
|
|---|
| 173 | I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
|
|---|
| 174 | .F Q:$Y>(IOSL-3) W !
|
|---|
| 175 | .N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
|
|---|
| 176 | .S DIR(0)="E"
|
|---|
| 177 | .D ^DIR
|
|---|
| 178 | .S STOP=$S(Y'=1:1,1:0)
|
|---|
| 179 | ;Background task - check taskman
|
|---|
| 180 | S STOP=$$S^%ZTLOAD()
|
|---|
| 181 | I STOP D
|
|---|
| 182 | .W !,"*********************************************"
|
|---|
| 183 | .W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
|
|---|
| 184 | .W !,"*********************************************"
|
|---|
| 185 | Q
|
|---|
