218 lines
7.4 KiB
Mathematica
218 lines
7.4 KiB
Mathematica
PSOCMOPR ;BHAM ISC/PDW - CMOP CONTROLLED SUBSTANCE RX DISPENSE REPORT ; 05 Nov 1999 9:39 AM
|
|
;;7.0;OUTPATIENT PHARMACY;**33,52**;DEC 1997
|
|
; External reference to file #550.2 granted by DBIA 2231
|
|
; External reference to file #50 granted by DBIA 221
|
|
Q
|
|
;
|
|
S ;ENTRY
|
|
I '$D(PSOPAR) D ^PSOLSET I '$D(PSOPAR) W $C(7),!!,"A Pharmacy Division Must Be Selected!",! G EXIT
|
|
; check for multi divisions
|
|
;
|
|
S X=0,I=0 F S I=$O(^PS(59,I)) Q:'I S X=X+1
|
|
I X<2 S QDIV="A" G CNT1
|
|
K DIR S DIR(0)="SA^A:All divisions;S:Single division"
|
|
S DIR("A")="Print for (A)ll or a (S)ingle division? (A/S) "
|
|
S DIR("B")="S"
|
|
D ^DIR K DIR
|
|
G:$D(DIRUT) EXIT
|
|
S QDIV=Y
|
|
; select division if QDIV="S"
|
|
I QDIV="S" D G:Y'>0 S
|
|
. K DIC
|
|
. S DIC(0)="AEQM",DIC=59 D ^DIC
|
|
. S:+Y QDIV=+Y
|
|
. K DIC
|
|
CNT1 ;Continue point 1
|
|
K DIR S DIR(0)="S^1:Sort by Release Date;2:Sort by Drug"
|
|
S DIR("A")="Select one of the following: "
|
|
S DIR("B")=1
|
|
D ^DIR K DIR
|
|
G:$D(DIRUT) EXIT
|
|
S QSORT=Y
|
|
DATE ; ask date range
|
|
K %DT
|
|
S %DT(0)="-NOW",%DT("A")="Enter Start date: ",%DT="AEPX" D ^%DT
|
|
G:"^"[$E(X) EXIT
|
|
S (%DT(0),SCANBDT)=Y
|
|
S Y=DT X ^DD("DD") S END=Y S %DT("A")="Ending date: ",%DT("B")=END D ^%DT K %DT
|
|
G:"^"[$E(X) EXIT
|
|
S SCANEDT=Y D DD^%DT S EDATE=Y
|
|
S Y=SCANBDT D DD^%DT S BDATE=Y
|
|
;
|
|
W !!,"This report is designed for a 132-column format.",!
|
|
W !,"It is recommended that this report be queued.",!!
|
|
;***
|
|
K IO("Q"),%ZIS,IOP,ZTSK S %ZIS="Q"
|
|
D ^%ZIS I POP S IOP=PSOION D ^%ZIS K IOP,PSOION G EXIT
|
|
K PSOION
|
|
; set subscript for ^XTMP storage
|
|
S PSOJOB=$J_"_"_$P($H,",",2)
|
|
S PSOSUB="PSO_CMOP_CS"_PSOJOB
|
|
; setup queing
|
|
I $D(IO("Q")) D G EXIT
|
|
. F X="BDATE","EDATE","QDIV","QSORT","SCANBDT","SCANEDT","PSOSUB" S ZTSAVE(X)=""
|
|
. S ZTRTN="DEQUEUE^PSOCMOPR",ZTDESC="Report of CMOP CS RX Dispenses"
|
|
. D ^%ZTLOAD W:$D(ZTSK) !,"Report Queued to Print !!",! K ZTSK,IO("Q")
|
|
;
|
|
DEQUEUE ; TASKING RE-ENTRY POINT AND PROCESSING
|
|
D COMPUTE,PRINT
|
|
G EXIT
|
|
Q
|
|
COMPUTE ; Deque point for computing
|
|
; store in ^XTMP(PSOSUB, for printing queue
|
|
K ^XTMP(PSOSUB),PSOQUIT
|
|
S X1=DT,X2=2 D C^%DTC
|
|
S ^XTMP(PSOSUB,0)=X_U_DT_"^ Storage for CMOP-CS-RX STATUS DIVISION REPORT"
|
|
S SCANDT=SCANBDT\1-.1
|
|
; Set status catagories
|
|
;
|
|
F S SCANDT=$O(^PSRX("AD",SCANDT)) Q:SCANDT>SCANEDT Q:SCANDT'>0 D
|
|
. S RX=0 F S RX=$O(^PSRX("AD",SCANDT,RX)) Q:RX'>0 D
|
|
.. S FILL="" F S FILL=$O(^PSRX("AD",SCANDT,RX,FILL)) Q:FILL="" D RX
|
|
Q
|
|
RX ; check & gather RX,Fills data
|
|
;
|
|
I '$D(^PSRX(RX,4)) Q ;no CMOP events
|
|
I '$O(^PSRX(RX,4,0)) Q ; no CMOP events
|
|
D CMOP ; get CMOP ST - FAC
|
|
Q:'TRANDA ; no CMOP event for FILL
|
|
;
|
|
; test for CS category 3,4,5 & C
|
|
S DRUGDA=$$GET1^DIQ(52,RX,6,"I")
|
|
S DEA=$$GET1^DIQ(50,DRUGDA,3)
|
|
I DEA'[3,DEA'[4,DEA'[5 Q
|
|
;
|
|
; get qty & div & reldt per original or refil
|
|
I FILL=0 S QTY=$$GET1^DIQ(52,RX,7),DIV=$$GET1^DIQ(52,RX,20),DIVDA=$$GET1^DIQ(52,RX,20,"I") S RELDT=$$GET1^DIQ(52,RX,31,"I") I 1
|
|
E D
|
|
. S RXF=^PSRX(RX,1,FILL,0)
|
|
. S QTY=$P(RXF,U,4),DIVDA=$P(RXF,U,9)
|
|
. S RELDT=$P(RXF,U,18)
|
|
. S DIV=$$GET1^DIQ(59,DIVDA,.01)
|
|
; test div if QDIV
|
|
I +QDIV,DIVDA'=QDIV Q
|
|
;
|
|
S:RELDT="" RELDT="Not Released"
|
|
S DRUG=$$GET1^DIQ(50,DRUGDA,.01) ; get DRG;
|
|
S PAT=$$GET1^DIQ(52,RX,2) ; get PAT
|
|
S PATDA=$$GET1^DIQ(52,RX,2,"I")
|
|
S SSN=$$GET1^DIQ(2,PATDA,.09),SSN="("_$E(SSN,6,9)_")"
|
|
;
|
|
; store according to sort
|
|
I QSORT=2 S ^XTMP(PSOSUB,DIV,DRUG,RELDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
E S ^XTMP(PSOSUB,DIV,RELDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
;
|
|
Q
|
|
;
|
|
CMOP ;loop CMOP event for fill, status, and facility
|
|
; sets TRANDA for XTMP subscript
|
|
S EVTRDA=0,TRANDA=0
|
|
S (ST,FAC)=""
|
|
; loop events : EVTRDA will be the last event for the FILL in question
|
|
S EVDA=0
|
|
F S EVDA=$O(^PSRX(RX,4,EVDA)) Q:EVDA'>0 S:FILL=$P(^(EVDA,0),U,3) EVTRDA=EVDA
|
|
Q:'EVTRDA
|
|
S EVENT=^PSRX(RX,4,EVTRDA,0)
|
|
S ST=$P(EVENT,U,4)
|
|
S ST=$S(ST=0:"T",ST=1:"D",ST=2:"RT",ST=3:"ND",1:"")
|
|
S TRANDA=$P(EVENT,U,1)
|
|
S FAC=$$GET1^DIQ(550.2,TRANDA,3)
|
|
K EVDA,EVTRDA
|
|
Q
|
|
PRINT ; print entry point
|
|
K PSOQUIT,PSOPG,DIV
|
|
S PSOQUIT=0
|
|
D COLUMN ; set column spacing
|
|
D PGHDR
|
|
I $O(^XTMP(PSOSUB,0))="" D G EXIT
|
|
. W !!,?5,"No Data To Report",!!
|
|
D:QSORT=1 BYDATE
|
|
D:QSORT=2 BYDRUG
|
|
K ^XTMP(PSOSUB)
|
|
Q
|
|
BYDATE ; print report by release date
|
|
;^XTMP(PSOSUB,DIV,SCANDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
S DIV=0 F S DIV=$O(^XTMP(PSOSUB,DIV)) Q:DIV="" Q:$G(PSOQUIT) D
|
|
. D DIVHDR
|
|
. S SCANDT=0 F S SCANDT=$O(^XTMP(PSOSUB,DIV,SCANDT)) Q:SCANDT="" Q:$G(PSOQUIT) D
|
|
.. S TRANDA=0 F S TRANDA=$O(^XTMP(PSOSUB,DIV,SCANDT,TRANDA)) Q:TRANDA'>0 Q:$G(PSOQUIT) D PRTDATE
|
|
Q
|
|
PRTDATE ; print by date output
|
|
;^XTMP(PSOSUB,DIV,SCANDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
S X=^XTMP(PSOSUB,DIV,SCANDT,TRANDA)
|
|
S PAT=$P(X,U,1),SSN=$P(X,U,2),QTY=$P(X,U,3),ST=$P(X,U,4)
|
|
S FAC=$P(X,U,5),RX=$P(X,U,6),FILL=$P(X,U,7),DRUG=$P(X,U,8)
|
|
S (DATE,Y)=SCANDT I +Y D DD^%DT S DATE=Y
|
|
S PAT=PAT_" "_SSN
|
|
S RX=$$GET1^DIQ(52,RX,.01)
|
|
;
|
|
D PG Q:$G(PSOQUIT)
|
|
W !,DATE,?C1,RX_" ("_FILL_")",?C2,PAT,?C3,ST,?C4,FAC,!,DRUG,?C5,"QTY: ",QTY,!
|
|
Q
|
|
BYDRUG ; pull in & print byDrug
|
|
;^XTMP(PSOSUB,DIV,DRUG,SCANDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
S DIV=0 F S DIV=$O(^XTMP(PSOSUB,DIV)) Q:DIV="" Q:$G(PSOQUIT) D
|
|
. D DIVHDR
|
|
. S DRUG="" F S DRUG=$O(^XTMP(PSOSUB,DIV,DRUG)) Q:DRUG="" Q:$G(PSOQUIT) D
|
|
.. W !!,?3,DRUG
|
|
.. S SCANDT=0 F S SCANDT=$O(^XTMP(PSOSUB,DIV,DRUG,SCANDT)) Q:SCANDT="" Q:$G(PSOQUIT) D
|
|
... S TRANDA=0 F S TRANDA=$O(^XTMP(PSOSUB,DIV,DRUG,SCANDT,TRANDA)) Q:TRANDA'>0 Q:$G(PSOQUIT) D PRTDRUG
|
|
Q
|
|
PRTDRUG ; print by Drug
|
|
;^XTMP(PSOSUB,DIV,DRUG,SCANDT,TRANDA)=PAT_U_SSN_U_QTY_U_ST_U_FAC_U_RX_U_FILL_U_DRUG
|
|
S X=^XTMP(PSOSUB,DIV,DRUG,SCANDT,TRANDA)
|
|
S PAT=$P(X,U,1),SSN=$P(X,U,2),QTY=$P(X,U,3),ST=$P(X,U,4)
|
|
S FAC=$P(X,U,5),RX=$P(X,U,6),FILL=$P(X,U,7)
|
|
S (DATE,Y)=SCANDT I +Y D DD^%DT S DATE=Y
|
|
S PAT=PAT_" "_SSN,RX=$$GET1^DIQ(52,RX,.01),RX=RX_" ("_FILL_")"
|
|
D PG Q:$G(PSOQUIT)
|
|
;"Release Date",?D1,"Rx#",?D2,"QTY",?D3,"Patient",?D4,"CMOP",?D5,"CMOP
|
|
W !,DATE,?D1,RX,?D2,QTY,?D3,PAT,?D4,ST,?D5,FAC
|
|
Q
|
|
EXIT ;EXIT
|
|
K BDATE,C1,C2,C3,C4,C5,C6,CMOP,D1,D2,D3,D4,D5,DATE,DEA,DIV,DIVDA,DRUG
|
|
K DRUGDA,EDATE,END,FAC,FIL,FLD,PAT,PATDA,PSOPG,PSOSUB,EVENT,RXF
|
|
K QDIV,QSORT,QTY,RX,SCANDT,SCANBDT,SCANEDT,SSN,ST,TRANDA,PSOQUIT
|
|
K FILL,EVDA,PSOJOB,PSOPAR,PSUIOP,PSUFQ,PSURC,PSURP,PSURX,PSUNS,X1,X2
|
|
D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
PG ;EP Page controller
|
|
;S PSOQUIT=0
|
|
Q:$G(PSOQUIT)
|
|
I $Y<(IOSL-4) Q
|
|
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR I $D(DIRUT) S PSOQUIT=1 Q
|
|
;
|
|
PGHDR ; Write Page Header
|
|
U IO W @IOF
|
|
S PSOPG("PG")=$G(PSOPG("PG"))+1
|
|
W !,"CMOP Controlled Substance Prescription Dispensing Report",?(IOM-12),"Page: ",PSOPG("PG")
|
|
W !,BDATE," through ",EDATE
|
|
D:$D(DIV) DIVHDR
|
|
Q
|
|
;
|
|
DIVHDR ; write division header
|
|
S X=DIV_" Division"
|
|
W !!,?((IOM-$L(X))\2),X,!!
|
|
I QSORT=1 D
|
|
. W !,"Release Date",?C1,"Rx#",?C2,"Patient",?C3,"CMOP",?C4,"CMOP"
|
|
. W !,?C3,"STATUS",?C4,"Facility",! ; RX at C5 QTY AT C6
|
|
. F X=1:1:IOM-2 W "-"
|
|
I QSORT=2 D
|
|
. W !,"Release Date",?D1,"Rx#",?D2,"QTY",?D3,"Patient",?D4,"CMOP",?D5,"CMOP"
|
|
. W !,?D4,"STATUS",?D5,"Facility",!
|
|
. F X=1:1:IOM-2 W "-"
|
|
. I PSOPG("PG")>1,$L($G(DRUG)) W !,?3,DRUG
|
|
Q
|
|
COLUMN ; setup column spacing
|
|
C1 ; setup column spacing for byDate
|
|
S C1=23,C2=39,C3=77,C4=85,C5=42
|
|
;W !,DATE,?C1,RX_" ("_FILL_")",?C2,PAT,?C3,ST,?C4,FAC,!,DRUG,?C5,"QT: ",QTY
|
|
D1 ; setup column spacing for byDrug
|
|
;"Release Date",?D1,"Rx#",?D2,"QTY",?D3,"Patient",?D4,"CMOP",?D5,"CMOP
|
|
S D1=23,D2=39,D3=53,D4=91,D5=99
|
|
Q
|
|
CLEAR ; clear ^XTMP
|
|
S X="PSO_CMOP_",Y=X
|
|
F S X=$O(^XTMP(X)) Q:X'[Y K ^XTMP(X)
|
|
Q
|