VistA-FOIAVistA/r/PHARMACY_BENEFITS_MANAGEMEN.../PSUCSR1.m

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)