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

PSUOP8.m

Go to the documentation of this file. 
  1. PSUOP8 ;BIR/DAM - Outpatient AMIS Summary Message;04 MAR 2004
  1.  ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
  1.  ;
  1.  ;Reference to file #59  supported by DBIA 2510
  1.  ;
  1. EN ;Entry point for MailMan message
  1.  ;Called from PSUOP0
  1.  ;
  1.  Q:$D(^XTMP("PSU_"_PSUJOB,"PSUFLAG"))  ;Quit if Provider extract only
  1.  D MSG
  1.  D MAIL
  1.  Q
  1.  ;
  1. MSG ;Create the Rx AMIS summary mailman message
  1.  ;Called from PSUOP0
  1.  ;
  1.  S (PSU30,PSU60,PSU90,PSUNADJ,PSUEQ,PSUTCST,PSUNADC,PSUCFIL)=""
  1.  S (PSUNEW,PSUREF,PSUWN,PSUWNCS,PSUML,PSUMLCS,PSUMP,PSULC)=""
  1.  S (PSUSTF,PSUFEE,PSULOCS,PSUSTNM)=""
  1.  ;
  1.  S PSUST=$P($G(^XTMP("PSU_"_PSUJOB,"PSUSITE")),U,1)    ;Facility #
  1.  S PSUSTNM=$P($G(^XTMP("PSU_"_PSUJOB,"PSUSITE")),U,2)  ;Facility name
  1.  ;
  1.  D TCOST      ;Calculate total cost for all Rx fills
  1.  ;
  1.  S Y=PSUSDT X ^DD("DD") S PSUDTS=Y
  1.  S Y=PSUEDT X ^DD("DD") S PSUDTE=Y
  1.  S AMIS(1)="Outpatient AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUSTNM
  1.  ;
  1.  S AMIS(2)=""
  1.  ;
  1.  S AMIS(3)="                                                         Unadj     30Day                      Cost/          Cost/"
  1.  ;
  1.  S AMIS(4)="                      30Day        60Day      90Day      Total     Equiv        Total        Unadj          30Day"
  1.  ;
  1.  S AMIS(5)="Division              Fills        Fills      Fills      Fills     Fills        Cost          Fill           Fill"
  1.  ;
  1.  S $P(AMIS(6),"-",132)=""      ;Separator bar
  1.  ;
  1.  S PSULN=7
  1.  ;
  1.  S PSUDVN=0
  1.  F  S PSUDVN=$O(^TMP($J,"FILL",PSUDVN)) Q:PSUDVN=""  D
  1.  .S X=PSUDVN,DIC=59,DIC(0)="XM" D ^DIC     ;Find division name
  1.  .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
  1.  .I '$G(PSUDIVNM) S X=PSUDVN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC D
  1.  ..S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1.  .D VAR
  1.  .D UNADCST
  1.  .D FILL
  1.  .D TOTAL1
  1.  .;
  1.  .;Construct line with spacing
  1.  .S PSULINE=""
  1.  .S $E(PSULINE,1,17)=PSUDIVNM
  1.  .S $E(PSULINE,18,28)=$J(FILL30,11)
  1.  .S $E(PSULINE,29,39)=$J(FILL60,11)
  1.  .S $E(PSULINE,40,50)=$J(FILL90,11)
  1.  .S $E(PSULINE,51,61)=$J(UNAD,11)
  1.  .S $E(PSULINE,62,72)=$J(EQUIV,11)
  1.  .S $E(PSULINE,74,75)="$"
  1.  .S $E(PSULINE,76,88)=$J(TCOST(PSUDVN),13)
  1.  .S $E(PSULINE,90,91)="$"
  1.  .S $E(PSULINE,92,102)=$J(UNADC(PSUDVN),11)
  1.  .S $E(PSULINE,104,105)="$"
  1.  .S $E(PSULINE,106,116)=$J(CFILL(PSUDVN),11)
  1.  .;End line
  1.  .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  S $P(AMIS(PSULN),"-",132)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  ;Construct line with spacing
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,17)="Total"
  1.  S $E(PSULINE,18,28)=$J(PSU30,11)
  1.  S $E(PSULINE,29,39)=$J(PSU60,11)
  1.  S $E(PSULINE,40,50)=$J(PSU90,11)
  1.  S $E(PSULINE,51,61)=$J(PSUNADJ,11)
  1.  S $E(PSULINE,62,72)=$J(PSUEQ,11)
  1.  S $E(PSULINE,74,75)="$"
  1.  S $E(PSULINE,76,88)=$J(PSUTCST,13)
  1.  S $E(PSULINE,90,91)="$"
  1.  S $E(PSULINE,92,102)=$J(PSUNADC,11)
  1.  S $E(PSULINE,104,105)="$"
  1.  S $E(PSULINE,106,116)=$J(PSUCFIL,11)
  1.  ;End line construction
  1.  ;
  1.  S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)=""     ;Blank lines
  1.  S PSULN=PSULN+1
  1.  ;
  1.  S AMIS(PSULN)="Unadjusted             New       Ref          Win           Mail               CMOP         Local           Staff         Fee" S PSULN=PSULN+1
  1.  ;
  1.  S AMIS(PSULN)="Division                Rx        Rx         Rx(CS)        Rx(CS)               Rx          Rx(CS)            Rx           Rx" S PSULN=PSULN+1
  1.  ;
  1.  S $P(AMIS(PSULN),"-",132)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  S PSUDVN=0
  1.  F  S PSUDVN=$O(^TMP($J,"NEW",PSUDVN)) Q:PSUDVN=""  D
  1.  .S X=PSUDVN,DIC=59,DIC(0)="XM" D ^DIC     ;Find division name
  1.  .S X=+Y,PSUDIVNM=$$VAL^PSUTL(59,X,.01)
  1.  .I '$G(PSUDIVNM) S X=PSUDVN,DIC=40.8,DIC(0)="X",D="C" D IX^DIC D
  1.  ..S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
  1.  .D VAR2
  1.  .D TOTAL2
  1.  .;Construct line with spacing
  1.  .S PSULINE=""
  1.  .S $E(PSULINE,1,17)=PSUDIVNM
  1.  .S $E(PSULINE,18,27)=$J(PSUN,10)
  1.  .S $E(PSULINE,28,37)=$J(PSUR,10)
  1.  .S $E(PSULINE,38,47)=$J(PSUW,10)
  1.  .S $E(PSULINE,48,57)="("_PSUWCS_")"
  1.  .S $E(PSULINE,58,67)=$J(PSUM,10)
  1.  .S $E(PSULINE,68,77)="("_PSUMCS_")"
  1.  .S $E(PSULINE,78,87)=$J(PSUMOP,10)
  1.  .S $E(PSULINE,88,97)=$J(PSULOC,10)
  1.  .S $E(PSULINE,98,107)="("_PSULCS_")"
  1.  .S $E(PSULINE,108,117)=$J(PSUTF,10)
  1.  .S $E(PSULINE,118,127)=$J(PSUFE,10)
  1.  .;End construction of line
  1.  .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  S $P(AMIS(PSULN),"-",132)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  ;Construct line with spacing
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,15)="Total"
  1.  S $E(PSULINE,18,27)=$J(PSUNEW,10)
  1.  S $E(PSULINE,28,37)=$J(PSUREF,10)
  1.  S $E(PSULINE,38,47)=$J(PSUWN,10)
  1.  S $E(PSULINE,48,57)="("_PSUWNCS_")"
  1.  S $E(PSULINE,58,67)=$J(PSUML,10)
  1.  S $E(PSULINE,68,77)="("_PSUMLCS_")"
  1.  S $E(PSULINE,78,87)=$J(PSUMP,10)
  1.  S $E(PSULINE,88,97)=$J(PSULC,10)
  1.  S $E(PSULINE,98,107)="("_PSULOCS_")"
  1.  S $E(PSULINE,108,117)=$J(PSUSTF,10)
  1.  S $E(PSULINE,118,127)=$J(PSUFEE,10)
  1.  ;End construction of line
  1.  S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  Q
  1.  ;
  1. VAR ;Set contents of ^TMP global into VARIABLES
  1.  ;
  1.  S (FILL30,FILL60,FILL90,UNAD,EQUIV)=""
  1.  ;
  1.  S FILL30=^TMP($J,"FILL",PSUDVN,30)      ;30 DAY FILLS
  1.  ;
  1.  S FILL60=^TMP($J,"FILL",PSUDVN,60)      ;60 DAY FILLS
  1.  ;
  1.  S FILL90=^TMP($J,"FILL",PSUDVN,90)      ;90 DAY FILLS
  1.  ;
  1.  S UNAD=^TMP($J,"UNAD",PSUDVN)           ;UNADJUSTED TOTAL FILLS
  1.  ;
  1.  S EQUIV=^TMP($J,"EQUIV",PSUDVN)         ;30 DAY EQUIV FILLS
  1.  ;
  1.  Q
  1.  ;
  1. TCOST ;Calculate total cost for prescription fills 
  1.  ;
  1.  S PSUTC="",PSUTCOST=""
  1.  ;
  1.  S PSUDIVN=0
  1.  F  S PSUDIVN=$O(^TMP($J,"COST",PSUDIVN)) Q:PSUDIVN=""  D
  1.  .S PSURXIEN=0
  1.  .F  S PSURXIEN=$O(^TMP($J,"COST",PSUDIVN,PSURXIEN)) Q:PSURXIEN=""  D
  1.  ..S PSUTCOST=^TMP($J,"COST",PSUDIVN,PSURXIEN)
  1.  ..S TCOST(PSUDIVN)=$G(TCOST(PSUDIVN))+PSUTCOST
  1.  ..I TCOST(PSUDIVN)'["." S TCOST(PSUDIVN)=TCOST(PSUDIVN)_".00" Q
  1.  ..N A,B,C
  1.  ..S A=$F(TCOST(PSUDIVN),".")  ;Find 1st position after decimal
  1.  ..S B=$E(TCOST(PSUDIVN),1,(A-1))   ;Extract dollars and decimal
  1.  ..S C=$E(TCOST(PSUDIVN),A,(A+1))   ;Extract cents after decimal
  1.  ..I $L(C)'=2 S C=$E(C,1)_0
  1.  ..S TCOST(PSUDIVN)=B_C
  1.  ;
  1.  Q
  1.  ;
  1. UNADCST ;Calculate Cost Per Unadjusted Fill
  1.  ;
  1.  N A,B,C
  1.  S UNADC(PSUDVN)=TCOST(PSUDVN)/UNAD
  1.  ;
  1.  I UNADC(PSUDVN)'["." S UNADC(PSUDVN)=UNADC(PSUDVN)_".00" Q
  1.  ;
  1.  S A=$F(UNADC(PSUDVN),".")    ;Find position of 1st # after decimal
  1.  ;
  1.  S B=$E(UNADC(PSUDVN),1,(A-1)) ;Extract "dollars" up to decimal
  1.  ;
  1.  S C=$E(UNADC(PSUDVN),A,(A+1)) ;Extract "cents" after decimal
  1.  ;
  1.  S UNADC(PSUDVN)=B_C
  1.  Q
  1.  ;
  1. FILL ;Calculate Cost Per 30-day Fill
  1.  ;
  1.  N A,B,C
  1.  S CFILL(PSUDVN)=TCOST(PSUDVN)/EQUIV
  1.  ;
  1.  I CFILL(PSUDVN)'["." S CFILL(PSUDVN)=CFILL(PSUDVN)_".00" Q
  1.  ;
  1.  S A=$F(CFILL(PSUDVN),".")    ;Find position of 1st # after decimal
  1.  ;
  1.  S B=$E(CFILL(PSUDVN),1,(A-1)) ;Extract "dollars" up to decimal
  1.  ;
  1.  S C=$E(CFILL(PSUDVN),A,(A+1)) ;Extract "cents" after decimal
  1.  ;
  1.  S CFILL(PSUDVN)=B_C
  1.  ;
  1.  Q
  1.  ;
  1. VAR2 ;Set contents of ^TMP globals into variables
  1.  ;
  1.  S (PSUN,PSUR,PSUW,PSUWCS,PSUM,PSUMCS)=""
  1.  S (PSUMOP,PSULOC,PSULCS,PSUTF,PSUFE)=""
  1.  ;
  1.  S PSUN=^TMP($J,"NEW",PSUDVN)           ;NEW FILLS
  1.  ;
  1.  S PSUR=^TMP($J,"REF",PSUDVN)           ;REFILLS
  1.  ;
  1.  S PSUW=^TMP($J,"WIN",PSUDVN)           ;WINDOW FILLS
  1.  ;
  1.  S PSUWCS=^TMP($J,"WINCS",PSUDVN)       ;WINDOW CS
  1.  ;
  1.  S PSUM=^TMP($J,"MAIL",PSUDVN)          ;MAIL FILLS
  1.  ;
  1.  S PSUMCS=^TMP($J,"MAILCS",PSUDVN)      ;MAIL CS
  1.  ;
  1.  S PSUMOP=^TMP($J,"CMOP",PSUDVN)        ;CMOP FILLS
  1.  ;
  1.  S PSULOC=^TMP($J,"LOC",PSUDVN)         ;LOCAL FILLS
  1.  ;
  1.  S PSULCS=^TMP($J,"LOCS",PSUDVN)        ;LOCAL CS
  1.  ;
  1.  S PSUTF=^TMP($J,"STAFF",PSUDVN)        ;STAFF FILLS
  1.  ;
  1.  S PSUFE=^TMP($J,"FEE",PSUDVN)          ;FEE FILLS
  1.  ;
  1.  Q
  1.  ;
  1. TOTAL1 ;Add each column to get totals for all divisions
  1.  ;
  1.  ;
  1.  S PSU30=$G(PSU30)+FILL30               ;Total 30 day fills
  1.  ;
  1.  S PSU60=$G(PSU60)+FILL60               ;Total 60 day fills
  1.  ;
  1.  S PSU90=$G(PSU90)+FILL90               ;Total 90 day fills
  1.  ;
  1.  S PSUNADJ=$G(PSUNADJ)+UNAD             ;Total unadjusted fills
  1.  ;
  1.  S PSUEQ=$G(PSUEQ)+EQUIV                ;Total 30 day equiv fills
  1.  ;
  1.  S PSUTCST=$G(PSUTCST)+TCOST(PSUDVN)    ;Total of Total Cost
  1.  ;
  1.  ;S PSUNADC=$G(PSUNADC)+UNADC(PSUDVN)    ;Total of Cost/Unadj fill
  1.  I $G(PSUNADJ) S PSUNADC=$G(PSUTCST)/PSUNADJ D
  1.  .I PSUNADC'["." S PSUNADC=PSUNADC_".00" Q
  1.  .N A,B,C
  1.  .S A=$F(PSUNADC,".")  ;Find 1st position after decimal
  1.  .S B=$E(PSUNADC,1,(A-1))   ;Extract dollars and decimal
  1.  .S C=$E(PSUNADC,A,(A+1))   ;Extract cents after decimal
  1.  .I $L(C)'=2 S C=$E(C,1)_0
  1.  .S PSUNADC=B_C
  1.  ;
  1.  ;S PSUCFIL=$G(PSUCFIL)+CFILL(PSUDVN)    ;Total of Cost/30day fill
  1.  I $G(PSUEQ) S PSUCFIL=$G(PSUTCST)/PSUEQ D
  1.  .I PSUCFIL'["." S PSUCFIL=PSUCFIL_".00" Q
  1.  .N A,B,C
  1.  .S A=$F(PSUCFIL,".")  ;Find 1st position after decimal
  1.  .S B=$E(PSUCFIL,1,(A-1))   ;Extract dollars and decimal
  1.  .S C=$E(PSUCFIL,A,(A+1))   ;Extract cents after decimal
  1.  .I $L(C)'=2 S C=$E(C,1)_0
  1.  .S PSUCFIL=B_C
  1.  ;
  1.  Q
  1.  ;
  1. TOTAL2 ;Add each column to get totals for all divisions
  1.  ;
  1.  S PSUNEW=$G(PSUNEW)+^TMP($J,"NEW",PSUDVN)
  1.  ;
  1.  S PSUREF=$G(PSUREF)+^TMP($J,"REF",PSUDVN)
  1.  ;
  1.  S PSUWN=$G(PSUWN)+^TMP($J,"WIN",PSUDVN)
  1.  ;
  1.  S PSUWNCS=$G(PSUWNCS)+^TMP($J,"WINCS",PSUDVN)
  1.  ;
  1.  S PSUML=$G(PSUML)+^TMP($J,"MAIL",PSUDVN)
  1.  ;
  1.  S PSUMLCS=$G(PSUMLCS)+^TMP($J,"MAILCS",PSUDVN)
  1.  ;
  1.  S PSUMP=$G(PSUMP)+^TMP($J,"CMOP",PSUDVN)
  1.  ;
  1.  S PSULC=$G(PSULC)+^TMP($J,"LOC",PSUDVN)
  1.  ;
  1.  S PSULOCS=$G(PSULOCS)+^TMP($J,"LOCS",PSUDVN)
  1.  ;
  1.  S PSUSTF=$G(PSUSTF)+^TMP($J,"STAFF",PSUDVN)
  1.  ;
  1.  S PSUFEE=$G(PSUFEE)+^TMP($J,"FEE",PSUDVN)
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ;Send AMIS summary mailman message
  1.  ;
  1.  ;Do not send report if option selection includes 1,2,3,4,6
  1.  I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D  Q
  1.  .M ^XTMP("PSU_"_PSUJOB,"OPCOMBO")=AMIS
  1.  .S ^XTMP("PSU_"_PSUJOB,"OPCOMBO",1)="OUTPATIENT:"
  1.  ;
  1.  S XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUST_" "_PSUSTNM
  1.  S XMTEXT="AMIS("
  1.  M ^XTMP("PSU_"_PSUJOB,"OPAMIS")=AMIS
  1.  S XMCHAN=1
  1.  M XMY=PSUXMYS2
  1.  D ^XMD
  1.  ;
  1.  Q