Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUCSR1

PSUCSR1.m

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