169 lines
5.0 KiB
Mathematica
169 lines
5.0 KiB
Mathematica
|
PSUCSR1 ;BIR/DJM - Drug breakdown ;25 AUG 1998
|
||
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
||
|
; DBIA(s)
|
||
|
; Reference to file #40.8 supported by DBIA 2438
|
||
|
;
|
||
|
EN ;EP -- DRUG BREAKDOWN REPORT
|
||
|
;
|
||
|
S RC="^XTMP(PSUCSJB,""RECORDS"",PSUDIV,PSUTIEN,PSURC)"
|
||
|
I $G(@RC@(0))'=2 Q
|
||
|
S PSUGNM=$G(@RC@(9))
|
||
|
S PSUBU=$G(@RC@(14))
|
||
|
S PSUBU=$S(PSUBU="":"N/A",1:PSUBU)
|
||
|
S PSUPSZ=$G(@RC@(15))
|
||
|
S PSUPSZ=$S(PSUPSZ="":"N/A",1:PSUPSZ)
|
||
|
S PSUNFI=$G(@RC@(10))
|
||
|
S PSUVFI=$G(@RC@(11))
|
||
|
S PSUCST=$G(@RC@(16))
|
||
|
S PSUQTY=$G(@RC@(17))
|
||
|
S PSUCST=PSUCST*PSUQTY
|
||
|
S PSUTCST=$G(PSUTCST)+PSUCST
|
||
|
; pull previous counters
|
||
|
; PSUGNM-drug name; PSUBU-break down unit/dispense unit
|
||
|
; PSUPSZ-package size
|
||
|
S PSUX=$G(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ))
|
||
|
S PSUOQTY=$P(PSUX,U,3)
|
||
|
S PSUOCST=$P(PSUX,U,4)
|
||
|
S PSUOCNT=$P(PSUX,U,5)
|
||
|
; update/store counters
|
||
|
S PSUTCST=PSUOCST+PSUCST
|
||
|
S PSUTQTY=PSUOQTY+PSUQTY
|
||
|
S PSUTCNT=PSUOCNT+1
|
||
|
S PSUX=PSUNFI_U_PSUVFI_U_PSUTQTY_U_PSUTCST_U_PSUTCNT
|
||
|
S ^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ)=PSUX
|
||
|
Q
|
||
|
;
|
||
|
;
|
||
|
GENREP(PSUMSG) ;EP - Generate the report based on the collected information
|
||
|
;
|
||
|
S PSUPGS("PG")=1
|
||
|
D PGHDR1
|
||
|
S PSUL=3
|
||
|
F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL)) Q:PSUL="" D
|
||
|
.I LNCNT+4>IOSL D PGHDR1
|
||
|
.W !,^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL)
|
||
|
.S LNCNT=LNCNT+1
|
||
|
Q
|
||
|
COMBO(PSUMSG) ;EP - Generate the report based on the collected information
|
||
|
;
|
||
|
S PSUPGS("PG")=1
|
||
|
D PGHDR2
|
||
|
S PSUL=3
|
||
|
F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL)) Q:PSUL="" D
|
||
|
.I LNCNT+4>IOSL D PGHDR2
|
||
|
.W !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL)
|
||
|
.S LNCNT=LNCNT+1
|
||
|
Q
|
||
|
;
|
||
|
PGHDR1 ;AMIS PAGE HEADER
|
||
|
U IO
|
||
|
W @IOF
|
||
|
W !,^XTMP("PSU_"_PSUJOB,"CSAMIS",1)
|
||
|
W !!,?68,"Page: ",PSUPGS("PG")
|
||
|
W !,$G(^XTMP("PSU_"_PSUJOB,"IVAMIS",2))
|
||
|
S LNCNT=3
|
||
|
Q
|
||
|
;
|
||
|
PGHDR2 ;COMBO AMIS PAGE HEADER
|
||
|
U IO
|
||
|
W @IOF
|
||
|
W !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",1)
|
||
|
W !!,?68,"Page: ",PSUPGS("PG")
|
||
|
W !,$G(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",2))
|
||
|
S LNCNT=3
|
||
|
Q
|
||
|
;
|
||
|
PG ;EP Page controller
|
||
|
S PSUQUIT=0
|
||
|
I $Y<(IOSL-4) Q
|
||
|
S:'$D(PSUPG("PG")) PSUPG("PG")=0
|
||
|
S PSUPG("PG")=PSUPG("PG")+1
|
||
|
I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR
|
||
|
I $G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT) S PSUQUIT=1
|
||
|
U IO W @IOF
|
||
|
Q:$G(PSUQUIT)
|
||
|
;
|
||
|
PGHDR ;EP write header & page number
|
||
|
F I=1,2 W !,^XTMP(PSUCSJB,"MAIL",PSUMC,I)
|
||
|
W !,?60,"PAGE: ",PSUPG("PG")
|
||
|
F I=4,5,6 I $D(^XTMP(PSUCSJB,"MAIL",PSUMC,I)) W !,^(I)
|
||
|
Q
|
||
|
;
|
||
|
SUMMRY(PSUMSG,PSUMFL) ; Mail the drug summary report (by division)
|
||
|
K PSUTCSO,PSUTCST
|
||
|
S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
|
||
|
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
||
|
S PSUMFL=$G(PSUMFL,1)
|
||
|
S PSUOMC=PSUMC,PSUMLC=0
|
||
|
S PSUMC=PSUMC+1,PSULC=0,PSUTLC=0
|
||
|
S PSUDRG="",PSUQDTL=0,PSUTCSO=0,PSUTCST=0
|
||
|
S PSUDSHL=$$PAD("","-",76)
|
||
|
S PSULC=PSULC+1
|
||
|
S ML="^XTMP(PSUCSJB,""MAIL"",PSUMC)"
|
||
|
S @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
|
||
|
S @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
||
|
S @ML@(3)=" "
|
||
|
S X=$$PAD(" "," ",45)_$$CTR("Breakdown"," ",10)_$$CTR("Package"," ",10)_"Quantity"
|
||
|
S @ML@(4)=X
|
||
|
S X=$$PAD("Drug Name"," ",45)_$$PAD("Unit"," ",10)_$$CTR("Size"," ",10)_"Dispensed"
|
||
|
S @ML@(5)=X
|
||
|
S @ML@(6)=PSUDSHL,PSULC=6
|
||
|
;
|
||
|
F S PSUDRG=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG)) Q:PSUDRG="" D
|
||
|
. S PSUBU=""
|
||
|
. F S PSUBU=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU)) Q:PSUBU="" D
|
||
|
.. S PSUSZ=""
|
||
|
.. F S PSUSZ=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ)) Q:PSUSZ="" D
|
||
|
... S X=$G(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ),"^^0")
|
||
|
... S PSUNFI=$P(X,U,1)
|
||
|
... S PSUVFI=$P(X,U,2)
|
||
|
... S PSUQTY=$P(X,U,3)
|
||
|
... S PSUCST=$P(X,U,4)
|
||
|
... S PSUTCST=PSUTCST+PSUCST
|
||
|
... S PSUCNT=$P(X,U,5),PSUTCSO=PSUTCSO+PSUCNT
|
||
|
... S X=PSUDRG_" "_$S(PSUVFI=0:"#",1:"")_$S(PSUNFI'="":"*",1:"")
|
||
|
... S X=$$PAD(X," ",45)
|
||
|
... S X=X_$$PAD(PSUBU," ",10)
|
||
|
... S X=X_$$PAD($J(PSUSZ,7)," ",12)
|
||
|
... S X=X_$$PAD($J(PSUQTY,7)," ",10)
|
||
|
... S PSUQDTL=PSUQDTL+PSUQTY ; Sum up the total quantity dispensed
|
||
|
... S PSULC=PSULC+1,PSUTLC=PSUTLC+1
|
||
|
... S @ML@(PSULC)=X
|
||
|
S ^XTMP(PSUCSJB,"REPORT",PSUMC)="" ; trigger print report
|
||
|
S ^XTMP(PSUCSJB,"SUMMARY 2",PSUMC)="" ;trigger mail & XMY group
|
||
|
I $G(PSUTCSO)=0 D ; No mail summary to send
|
||
|
. K ^XTMP(PSUCSJB,"MAIL",PSUMC)
|
||
|
. S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
|
||
|
. S ^XTMP(PSUCSJB,"REPORT",PSUMC)=""
|
||
|
. S @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
|
||
|
. S @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
||
|
. S @ML@(3)=" "
|
||
|
. S @ML@(4)="No data to report"
|
||
|
. S @ML@(5)=" "
|
||
|
I $G(PSUSMRY,0) D
|
||
|
. K ^XTMP(PSUCSJB,"MAIL",PSUMC),^XTMP(PSUCSJB,"REPORT",PSUMC)
|
||
|
I '$G(PSUSMRY,0),PSUTLC D
|
||
|
. S PSUTLC=PSUTLC+6 ; Adjust for the header
|
||
|
. ; Set total line
|
||
|
. S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
|
||
|
. S PSULC=PSULC+1,PSUTLC=PSUTLC+1
|
||
|
. S @ML@(PSULC)=PSUDSHL ; dashes line
|
||
|
. S PSULC=PSULC+1,PSUTLC=PSUTLC+1
|
||
|
. S @ML@(PSULC)=$$PAD("Totals:"," ",64)_$J(PSUQDTL,10)
|
||
|
. S PSULC=PSULC+1
|
||
|
. S @ML@(PSULC)=" "
|
||
|
. S PSULC=PSULC+1
|
||
|
. S @ML@(PSULC)=" * Non-Formulary"
|
||
|
. S PSULC=PSULC+1
|
||
|
. S @ML@(PSULC)=" # Not on National Formulary"
|
||
|
;
|
||
|
Q
|
||
|
;
|
||
|
EXIT1 S PSUMLC=0
|
||
|
Q
|
||
|
PAD(S,P,L) ; Pad string S with P to length L
|
||
|
S $P(P,P,L)=""
|
||
|
Q $E(S_P,1,L)
|
||
|
CTR(S,P,L) ; Center string S left and right P in size L
|
||
|
Q $$PAD($$PAD(P,P,L-$L(S)\2)_S,P,L)
|