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

PSUUD7.m

Go to the documentation of this file. 
  1. PSUUD7 ;BIR/DAM - UD AMIS Summary Message II;23 MAR 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 for MailMan message
  1.  ;Called from PSUUD0
  1.  ;
  1.  K AMIS,DOSE,DOSTOT,SPEC,DIVTOT,GTOT    ;Kill arrays to hold data
  1.  ;
  1.  D MSG
  1.  F PSULN=PSULN:1:(PSULN+3) S AMIS(PSULN)=""     ;Blank lines
  1.  M ^XTMP("PSU_"_PSUJOB,"UDAMIS")=AMIS
  1.  D MAIL
  1.  ;
  1.  Q
  1.  ;
  1. MSG ;Set up lines in 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.  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.  S AMIS(1)="UD AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
  1.  ;
  1.  S AMIS(2)=""       ;Blank line
  1.  ;
  1.  S AMIS(3)="                                      NET"
  1.  ;
  1.  S AMIS(4)="                    DOSES   DOSES     DOSES     TOTAL     AVG COST"
  1.  ;
  1.  S AMIS(5)="DIVISION            DISP    RET       DISP      COST      PER DOSE"
  1.  ;
  1.  S $P(AMIS(6),"-",78)=""      ;Separator bar
  1.  ;
  1.  S PSULN=7
  1.  ;
  1.  D DOSE
  1.  ;
  1.  S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  D DOST
  1.  ;
  1.  F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)=""       ;Blank lines
  1.  S PULN=PSULN+1
  1.  ;
  1.  S AMIS(PSULN)="Division                Specialty             Total Patient Days of Care"
  1.  ;
  1.  S PSULN=PSULN+1
  1.  ;
  1.  S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  D DIV      ;Calculate division data
  1.  D GTOT     ;Calculate grand totals
  1.  Q
  1.  ;
  1. DOSE ;Set doses into array and set data into message
  1.  ;
  1.  M DOSE=^XTMP(PSUUDSUB,"DOSES")
  1.  ;
  1.  S PSUDIV=0
  1.  F  S PSUDIV=$O(DOSE(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,24)=$J($P(DOSE(PSUDIV),U,1),7)
  1.  .S $E(PSULINE,25,32)=$J($P(DOSE(PSUDIV),U,2),8)
  1.  .S $E(PSULINE,33,42)=$J($P(DOSE(PSUDIV),U,3),10)
  1.  .S $E(PSULINE,44,45)="$"
  1.  .S $E(PSULINE,46,53)=$J($P(DOSE(PSUDIV),U,4),8)
  1.  .S $E(PSULINE,57,58)="$"
  1.  .S $E(PSULINE,59,64)=$J($P(DOSE(PSUDIV),U,5),6)
  1.  .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  Q
  1.  ;
  1. DOST ;Set dose totals into array and set into message
  1.  ;
  1.  M DOSTOT=^XTMP(PSUUDSUB,"DOSTOT")
  1.  I '$G(DOSTOT) S DOSTOT="0^0^0^0^0"
  1.  ;
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,17)="Total"
  1.  S $E(PSULINE,18,24)=$J($P(DOSTOT,U,1),7)
  1.  S $E(PSULINE,25,32)=$J($P(DOSTOT,U,2),8)
  1.  S $E(PSULINE,33,42)=$J($P(DOSTOT,U,3),10)
  1.  S $E(PSULINE,44,45)="$"
  1.  S $E(PSULINE,46,53)=$J($P(DOSTOT,U,4),8)
  1.  S $E(PSULINE,57,58)="$"
  1.  S $E(PSULINE,59,64)=$J($P(DOSTOT,U,5),6)
  1.  S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  Q
  1.  ;
  1. DIV ;Set division data into array and create message
  1.  ;
  1.  M SPEC=^XTMP(PSUUDSUB,"SPEC")
  1.  ;
  1.  ;
  1.  S PSUDV=0
  1.  F  S PSUDV=$O(SPEC(PSUDV)) Q:PSUDV=""  D
  1.  .S X=PSUDV,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 PSUSPC=0
  1.  .N C
  1.  .F  S PSUSPC=$O(SPEC(PSUDV,PSUSPC)) Q:PSUSPC=""  D
  1.  ..S PSULINE=""
  1.  ..I '$D(C) S $E(PSULINE,1,17)=PSUDIVNM S C=""
  1.  ..S $E(PSULINE,25,49)=$P(SPEC(PSUDV,PSUSPC),U,1)
  1.  ..S $E(PSULINE,50,59)=$J($P(SPEC(PSUDV,PSUSPC),U,2),10)
  1.  ..S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  .D DIVTOT
  1.  Q
  1.  ;
  1. DIVTOT ;Create message lines for division totals
  1.  ;
  1.  S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1      ;Separator bar 
  1.  ;
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,40)=PSUDIVNM_" Total"
  1.  S $E(PSULINE,50,59)=$J(^XTMP(PSUUDSUB,"DIVTOT",PSUDV),10)
  1.  S AMIS(PSULN)=PSULINE
  1.  ;
  1.  S PSULN=PSULN+1
  1.  ;
  1.  F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)=""     ;Blank lines
  1.  S PSULN=PSULN+1
  1.  Q
  1.  ;
  1. GTOT ;Calculate grand total patient days of care for all divisions
  1.  ;
  1.  S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1      ;Separator bar
  1.  ;
  1.  S PSULINE=""
  1.  S $E(PSULINE,1,40)="Grand Total"
  1.  S $E(PSULINE,50,59)=$J($G(^XTMP(PSUUDSUB,"GTOT")),10)
  1.  S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
  1.  ;
  1.  ;
  1.  Q
  1.  ;
  1. MAIL ;Send 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,"UDCOMBO")=AMIS
  1.  .S ^XTMP("PSU_"_PSUJOB,"UDCOMBO",1)="INPATIENT:"
  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 PBMUD "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
  1.  S XMTEXT="AMIS("
  1.  S XMDUZ=DUZ
  1.  M XMY=PSUXMY
  1.  S XMCHAN=1
  1.  I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
  1.  ;
  1.  Q