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

PSUCSR2.m

Go to the documentation of this file. 
  1. PSUCSR2 ;BIR/DAM - PBM CS AMIS SUMMARY;6 APR 2004
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1.  ;
  1.  ;Reference to file #40.8 supported by DBIA 2438
  1.  ;
  1. EN ;Entry point to create AMIS summary report
  1.  ;Called from ^PSUCSR1
  1.  ;
  1.  N TYP
  1.  K CSAM
  1.  ;
  1.  S PSUDV=0
  1.  F  S PSUDV=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV)) Q:PSUDV=""  D
  1.  .S PSUA=0
  1.  .F  S PSUA=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA)) Q:PSUA=""  D
  1.  ..S PSUB=0
  1.  ..F  S PSUB=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB)) Q:PSUB=""  D
  1.  ...S TYP=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,0)
  1.  ...I TYP=2 D
  1.  ....D DISP
  1.  ....D TCOST
  1.  .Q:'$D(CSAM(PSUDV))
  1.  .D AVE
  1.  .D TRUNC
  1.  ;
  1.  D TOTAL
  1.  D MSG
  1.  D MAIL
  1.  ;
  1.  Q
  1.  ;
  1. DISP ;Calculate orders dispensed
  1.  ;
  1.  S $P(CSAM(PSUDV),U,1)=$P($G(CSAM(PSUDV)),U,1)+1
  1.  ;
  1.  Q
  1.  ;
  1. TCOST ;Calculate total cost of orders dispensed
  1.  ;
  1.  N QTY,PRC
  1.  ;
  1.  S QTY=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,17)
  1.  S PRC=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,16)
  1.  ;
  1.  S $P(CSAM(PSUDV),U,2)=$P($G(CSAM(PSUDV)),U,2)+(QTY*PRC)
  1.  ;
  1.  Q
  1.  ;
  1. AVE ;Calculate average cost per order
  1.  ;
  1.  N TCST,DSP
  1.  ;
  1.  S DSP=$P(CSAM(PSUDV),U,1)
  1.  S TCST=$P(CSAM(PSUDV),U,2)
  1.  ;
  1.  S $P(CSAM(PSUDV),U,3)=$P($G(CSAM(PSUDV)),U,3)+(TCST/DSP)
  1.  ;
  1.  Q
  1.  ;
  1. TRUNC ;Truncate pieces with dollar values to 2 decimal places
  1.  ;
  1.  F I=2:1:3 D
  1.  .N A,B,C
  1.  .;
  1.  .I $P(CSAM(PSUDV),U,I)'["." D  Q
  1.  ..S $P(CSAM(PSUDV),U,I)=$P(CSAM(PSUDV),U,I)_".00"
  1.  .;
  1.  .S A=$F($P(CSAM(PSUDV),U,I),".")  ;Find first position after decimal
  1.  .;
  1.  .S B=$E($P(CSAM(PSUDV),U,I),1,(A-1))  ;Extract dollars and decimal
  1.  .;
  1.  .S C=$E($P(CSAM(PSUDV),U,I),A,(A+1))  ;Extract cents after decimal
  1.  .;
  1.  .I $L(C)'=2 S C=$E(C,1)_0
  1.  .;
  1.  .S $P(CSAM(PSUDV),U,I)=B_C
  1.  ;
  1.  Q
  1. TOTAL ;Add column totals
  1.  ;
  1.  N TDSP,TCST,TAVE
  1.  ;
  1.  S PSUDIV=0
  1.  F  S PSUDIV=$O(CSAM(PSUDIV)) Q:PSUDIV=""  D
  1.  .S TDSP=$G(TDSP)+$P(CSAM(PSUDIV),U,1)    ;Total orders dispensed
  1.  .S TCST=$G(TCST)+$P(CSAM(PSUDIV),U,2)    ;Total of total costs
  1.  .I $G(TDSP) S TAVE=$G(TCST)/TDSP D
  1.  ..I TAVE'["." S TAVE=TAVE_".00" Q
  1.  ..N A,B,C
  1.  ..S A=$F(TAVE,".")  ;Find 1st position after decimal
  1.  ..S B=$E(TAVE,1,(A-1))   ;Extract dollars and decimal
  1.  ..S C=$E(TAVE,A,(A+1))   ;Extract cents after decimal
  1.  ..I $L(C)'=2 S C=$E(C,1)_0
  1.  ..S TAVE=B_C
  1.  ;
  1.  S TOTAL("TOT")=$G(TDSP)_U_$G(TCST)_U_$G(TAVE)
  1.  ;
  1.  Q
  1.  ;
  1. MSG ;Construct lines for the MailMan message
  1.  ;
  1.  S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ;    start date
  1.  S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ;    end date
  1.  ;
  1.  K AMISC      ;Array to hold message lines
  1.  ;
  1.  S AMISC(1)="Controlled AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
  1.  ;
  1.  S AMISC(2)=""                       ;Blank line
  1.  ;
  1.  I '$D(CSAM) D  Q
  1.  .S AMISC(3)=" "
  1.  .S AMISC(4)="No data to report"
  1.  .S AMISC(5)=" "
  1.  ;
  1.  S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
  1.  ;
  1.  S AMISC(3)="INPATIENT CONTROLLED SUBSTANCE ORDERS:"
  1.  ;
  1.  S AMISC(4)=""                       ;Blank line
  1.  ;
  1.  S AMISC(5)="                            ORDERS               TOTAL     AVE COST"
  1.  S AMISC(6)="DIVISION                    DISPENSED            COST      PER ORDER"
  1.  ;
  1.  S $P(AMISC(7),"-",78)=""      ;Separator bar
  1.  ;
  1.  S PSULN=8
  1.  ;
  1.  S PSUDIV=0
  1.  F  S PSUDIV=$O(CSAM(PSUDIV)) Q:PSUDIV=""  D
  1.  .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)
  1.  .S PSULINE=""
  1.  .S $E(PSULINE,1,17)=PSUDIVNM
  1.  .S $E(PSULINE,18,35)=$J($P(CSAM(PSUDIV),U,1),18)
  1.  .S $E(PSULINE,41,42)="$"
  1.  .S $E(PSULINE,43,53)=$J($P(CSAM(PSUDIV),U,2),11)
  1.  .S $E(PSULINE,60,61)="$"
  1.  .S $E(PSULINE,62,67)=$J($P(CSAM(PSUDIV),U,3),6)
  1.  .S AMISC(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  S $P(AMISC(PSULN),"-",78)=""     ;Separator bar
  1.  S PSULN=PSULN+1
  1.  ;
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,17)="Total"
  1.  S $E(PSULINE,18,35)=$J($P(TOTAL("TOT"),U,1),18)
  1.  S $E(PSULINE,41,42)="$"
  1.  S $E(PSULINE,43,53)=$J($P(TOTAL("TOT"),U,2),11)
  1.  S $E(PSULINE,60,61)="$"
  1.  S $E(PSULINE,62,67)=$J($P(TOTAL("TOT"),U,3),6)
  1.  S AMISC(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  F PSULN=PSULN:1:(PSULN+2) S AMISC(PSULN)=""     ;Blank lines
  1.  Q
  1.  ;
  1. MAIL ;Mail CS AMIS summary report
  1.  ;
  1.  ;Do not send report if option selection includes 1,2,3,4,6
  1.  ;Instead send the combined AMIS summary report
  1.  I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D  Q
  1.  .M ^XTMP("PSU_"_PSUJOB,"CSCOMBO")=AMISC
  1.  .S ^XTMP("PSU_"_PSUJOB,"CSCOMBO",1)=""
  1.  .D EN^PSUAMC
  1.  ;
  1.  M XMY=PSUXMYS2
  1.  ;
  1.  S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
  1.  S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1.  ;
  1.  S XMSUB="V. 4.0 PBMCS "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
  1.  S XMTEXT="AMISC("
  1.  M ^XTMP("PSU_"_PSUJOB,"CSAMIS")=AMISC
  1.  S XMCHAN=1
  1.  D ^XMD
  1.  ;
  1.  Q