- 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)
- 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)