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)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCSR1 5328 printed Oct 16, 2024@18:28:22 Page 2
PSUCSR1 ;BIR/DJM - Drug breakdown ;25 AUG 1998
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ; DBIA(s)
+3 ; Reference to file #40.8 supported by DBIA 2438
+4 ;
EN ;EP -- DRUG BREAKDOWN REPORT
+1 ;
+2 SET RC="^XTMP(PSUCSJB,""RECORDS"",PSUDIV,PSUTIEN,PSURC)"
+3 IF $GET(@RC@(0))'=2
QUIT
+4 SET PSUGNM=$GET(@RC@(9))
+5 SET PSUBU=$GET(@RC@(14))
+6 SET PSUBU=$SELECT(PSUBU="":"N/A",1:PSUBU)
+7 SET PSUPSZ=$GET(@RC@(15))
+8 SET PSUPSZ=$SELECT(PSUPSZ="":"N/A",1:PSUPSZ)
+9 SET PSUNFI=$GET(@RC@(10))
+10 SET PSUVFI=$GET(@RC@(11))
+11 SET PSUCST=$GET(@RC@(16))
+12 SET PSUQTY=$GET(@RC@(17))
+13 SET PSUCST=PSUCST*PSUQTY
+14 SET PSUTCST=$GET(PSUTCST)+PSUCST
+15 ; pull previous counters
+16 ; PSUGNM-drug name; PSUBU-break down unit/dispense unit
+17 ; PSUPSZ-package size
+18 SET PSUX=$GET(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ))
+19 SET PSUOQTY=$PIECE(PSUX,U,3)
+20 SET PSUOCST=$PIECE(PSUX,U,4)
+21 SET PSUOCNT=$PIECE(PSUX,U,5)
+22 ; update/store counters
+23 SET PSUTCST=PSUOCST+PSUCST
+24 SET PSUTQTY=PSUOQTY+PSUQTY
+25 SET PSUTCNT=PSUOCNT+1
+26 SET PSUX=PSUNFI_U_PSUVFI_U_PSUTQTY_U_PSUTCST_U_PSUTCNT
+27 SET ^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ)=PSUX
+28 QUIT
+29 ;
+30 ;
GENREP(PSUMSG) ;EP - Generate the report based on the collected information
+1 ;
+2 SET PSUPGS("PG")=1
+3 DO PGHDR1
+4 SET PSUL=3
+5 FOR
SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL))
if PSUL=""
QUIT
Begin DoDot:1
+6 IF LNCNT+4>IOSL
DO PGHDR1
+7 WRITE !,^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL)
+8 SET LNCNT=LNCNT+1
End DoDot:1
+9 QUIT
COMBO(PSUMSG) ;EP - Generate the report based on the collected information
+1 ;
+2 SET PSUPGS("PG")=1
+3 DO PGHDR2
+4 SET PSUL=3
+5 FOR
SET PSUL=$ORDER(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL))
if PSUL=""
QUIT
Begin DoDot:1
+6 IF LNCNT+4>IOSL
DO PGHDR2
+7 WRITE !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL)
+8 SET LNCNT=LNCNT+1
End DoDot:1
+9 QUIT
+10 ;
PGHDR1 ;AMIS PAGE HEADER
+1 USE IO
+2 WRITE @IOF
+3 WRITE !,^XTMP("PSU_"_PSUJOB,"CSAMIS",1)
+4 WRITE !!,?68,"Page: ",PSUPGS("PG")
+5 WRITE !,$GET(^XTMP("PSU_"_PSUJOB,"IVAMIS",2))
+6 SET LNCNT=3
+7 QUIT
+8 ;
PGHDR2 ;COMBO AMIS PAGE HEADER
+1 USE IO
+2 WRITE @IOF
+3 WRITE !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",1)
+4 WRITE !!,?68,"Page: ",PSUPGS("PG")
+5 WRITE !,$GET(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",2))
+6 SET LNCNT=3
+7 QUIT
+8 ;
PG ;EP Page controller
+1 SET PSUQUIT=0
+2 IF $Y<(IOSL-4)
QUIT
+3 if '$DATA(PSUPG("PG"))
SET PSUPG("PG")=0
+4 SET PSUPG("PG")=PSUPG("PG")+1
+5 IF $EXTRACT(IOST)="C"
KILL DIR
SET DIR(0)="E"
DO ^DIR
+6 IF $GET(DIROUT)!$GET(DUOUT)!$GET(DTOUT)!$GET(DIRUT)
SET PSUQUIT=1
+7 USE IO
WRITE @IOF
+8 if $GET(PSUQUIT)
QUIT
+9 ;
PGHDR ;EP write header & page number
+1 FOR I=1,2
WRITE !,^XTMP(PSUCSJB,"MAIL",PSUMC,I)
+2 WRITE !,?60,"PAGE: ",PSUPG("PG")
+3 FOR I=4,5,6
IF $DATA(^XTMP(PSUCSJB,"MAIL",PSUMC,I))
WRITE !,^(I)
+4 QUIT
+5 ;
SUMMRY(PSUMSG,PSUMFL) ; Mail the drug summary report (by division)
+1 KILL PSUTCSO,PSUTCST
+2 ;**1
SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+3 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+4 SET PSUMFL=$GET(PSUMFL,1)
+5 SET PSUOMC=PSUMC
SET PSUMLC=0
+6 SET PSUMC=PSUMC+1
SET PSULC=0
SET PSUTLC=0
+7 SET PSUDRG=""
SET PSUQDTL=0
SET PSUTCSO=0
SET PSUTCST=0
+8 SET PSUDSHL=$$PAD("","-",76)
+9 SET PSULC=PSULC+1
+10 SET ML="^XTMP(PSUCSJB,""MAIL"",PSUMC)"
+11 SET @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
+12 SET @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+13 SET @ML@(3)=" "
+14 SET X=$$PAD(" "," ",45)_$$CTR("Breakdown"," ",10)_$$CTR("Package"," ",10)_"Quantity"
+15 SET @ML@(4)=X
+16 SET X=$$PAD("Drug Name"," ",45)_$$PAD("Unit"," ",10)_$$CTR("Size"," ",10)_"Dispensed"
+17 SET @ML@(5)=X
+18 SET @ML@(6)=PSUDSHL
SET PSULC=6
+19 ;
+20 FOR
SET PSUDRG=$ORDER(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG))
if PSUDRG=""
QUIT
Begin DoDot:1
+21 SET PSUBU=""
+22 FOR
SET PSUBU=$ORDER(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU))
if PSUBU=""
QUIT
Begin DoDot:2
+23 SET PSUSZ=""
+24 FOR
SET PSUSZ=$ORDER(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ))
if PSUSZ=""
QUIT
Begin DoDot:3
+25 SET X=$GET(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ),"^^0")
+26 SET PSUNFI=$PIECE(X,U,1)
+27 SET PSUVFI=$PIECE(X,U,2)
+28 SET PSUQTY=$PIECE(X,U,3)
+29 SET PSUCST=$PIECE(X,U,4)
+30 SET PSUTCST=PSUTCST+PSUCST
+31 SET PSUCNT=$PIECE(X,U,5)
SET PSUTCSO=PSUTCSO+PSUCNT
+32 SET X=PSUDRG_" "_$SELECT(PSUVFI=0:"#",1:"")_$SELECT(PSUNFI'="":"*",1:"")
+33 SET X=$$PAD(X," ",45)
+34 SET X=X_$$PAD(PSUBU," ",10)
+35 SET X=X_$$PAD($JUSTIFY(PSUSZ,7)," ",12)
+36 SET X=X_$$PAD($JUSTIFY(PSUQTY,7)," ",10)
+37 ; Sum up the total quantity dispensed
SET PSUQDTL=PSUQDTL+PSUQTY
+38 SET PSULC=PSULC+1
SET PSUTLC=PSUTLC+1
+39 SET @ML@(PSULC)=X
End DoDot:3
End DoDot:2
End DoDot:1
+40 ; trigger print report
SET ^XTMP(PSUCSJB,"REPORT",PSUMC)=""
+41 ;trigger mail & XMY group
SET ^XTMP(PSUCSJB,"SUMMARY 2",PSUMC)=""
+42 ; No mail summary to send
IF $GET(PSUTCSO)=0
Begin DoDot:1
+43 KILL ^XTMP(PSUCSJB,"MAIL",PSUMC)
+44 SET ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
+45 SET ^XTMP(PSUCSJB,"REPORT",PSUMC)=""
+46 SET @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
+47 SET @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+48 SET @ML@(3)=" "
+49 SET @ML@(4)="No data to report"
+50 SET @ML@(5)=" "
End DoDot:1
+51 IF $GET(PSUSMRY,0)
Begin DoDot:1
+52 KILL ^XTMP(PSUCSJB,"MAIL",PSUMC),^XTMP(PSUCSJB,"REPORT",PSUMC)
End DoDot:1
+53 IF '$GET(PSUSMRY,0)
IF PSUTLC
Begin DoDot:1
+54 ; Adjust for the header
SET PSUTLC=PSUTLC+6
+55 ; Set total line
+56 SET ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
+57 SET PSULC=PSULC+1
SET PSUTLC=PSUTLC+1
+58 ; dashes line
SET @ML@(PSULC)=PSUDSHL
+59 SET PSULC=PSULC+1
SET PSUTLC=PSUTLC+1
+60 SET @ML@(PSULC)=$$PAD("Totals:"," ",64)_$JUSTIFY(PSUQDTL,10)
+61 SET PSULC=PSULC+1
+62 SET @ML@(PSULC)=" "
+63 SET PSULC=PSULC+1
+64 SET @ML@(PSULC)=" * Non-Formulary"
+65 SET PSULC=PSULC+1
+66 SET @ML@(PSULC)=" # Not on National Formulary"
End DoDot:1
+67 ;
+68 QUIT
+69 ;
EXIT1 SET PSUMLC=0
+1 QUIT
PAD(S,P,L) ; Pad string S with P to length L
+1 SET $PIECE(P,P,L)=""
+2 QUIT $EXTRACT(S_P,1,L)
CTR(S,P,L) ; Center string S left and right P in size L
+1 QUIT $$PAD($$PAD(P,P,L-$LENGTH(S)\2)_S,P,L)
