| 1 | PSUUD7 ;BIR/DAM - UD AMIS Summary Message II;23 MAR 2004
|
---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
---|
| 3 | ;
|
---|
| 4 | ;Reference to file #40.8 supported by DBIA 2438
|
---|
| 5 | ;
|
---|
| 6 | EN ;Entry point for MailMan message
|
---|
| 7 | ;Called from PSUUD0
|
---|
| 8 | ;
|
---|
| 9 | K AMIS,DOSE,DOSTOT,SPEC,DIVTOT,GTOT ;Kill arrays to hold data
|
---|
| 10 | ;
|
---|
| 11 | D MSG
|
---|
| 12 | F PSULN=PSULN:1:(PSULN+3) S AMIS(PSULN)="" ;Blank lines
|
---|
| 13 | M ^XTMP("PSU_"_PSUJOB,"UDAMIS")=AMIS
|
---|
| 14 | D MAIL
|
---|
| 15 | ;
|
---|
| 16 | Q
|
---|
| 17 | ;
|
---|
| 18 | MSG ;Set up lines in message
|
---|
| 19 | ;
|
---|
| 20 | S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
|
---|
| 21 | S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
|
---|
| 22 | ;
|
---|
| 23 | S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
|
---|
| 24 | S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
---|
| 25 | S AMIS(1)="UD AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
|
---|
| 26 | ;
|
---|
| 27 | S AMIS(2)="" ;Blank line
|
---|
| 28 | ;
|
---|
| 29 | S AMIS(3)=" NET"
|
---|
| 30 | ;
|
---|
| 31 | S AMIS(4)=" DOSES DOSES DOSES TOTAL AVG COST"
|
---|
| 32 | ;
|
---|
| 33 | S AMIS(5)="DIVISION DISP RET DISP COST PER DOSE"
|
---|
| 34 | ;
|
---|
| 35 | S $P(AMIS(6),"-",78)="" ;Separator bar
|
---|
| 36 | ;
|
---|
| 37 | S PSULN=7
|
---|
| 38 | ;
|
---|
| 39 | D DOSE
|
---|
| 40 | ;
|
---|
| 41 | S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
|
---|
| 42 | ;
|
---|
| 43 | D DOST
|
---|
| 44 | ;
|
---|
| 45 | F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
|
---|
| 46 | S PULN=PSULN+1
|
---|
| 47 | ;
|
---|
| 48 | S AMIS(PSULN)="Division Specialty Total Patient Days of Care"
|
---|
| 49 | ;
|
---|
| 50 | S PSULN=PSULN+1
|
---|
| 51 | ;
|
---|
| 52 | S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
|
---|
| 53 | ;
|
---|
| 54 | D DIV ;Calculate division data
|
---|
| 55 | D GTOT ;Calculate grand totals
|
---|
| 56 | Q
|
---|
| 57 | ;
|
---|
| 58 | DOSE ;Set doses into array and set data into message
|
---|
| 59 | ;
|
---|
| 60 | M DOSE=^XTMP(PSUUDSUB,"DOSES")
|
---|
| 61 | ;
|
---|
| 62 | S PSUDIV=0
|
---|
| 63 | F S PSUDIV=$O(DOSE(PSUDIV)) Q:PSUDIV="" D
|
---|
| 64 | .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
|
---|
| 65 | .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
---|
| 66 | .S PSULINE=""
|
---|
| 67 | .S $E(PSULINE,1,17)=PSUDIVNM
|
---|
| 68 | .S $E(PSULINE,18,24)=$J($P(DOSE(PSUDIV),U,1),7)
|
---|
| 69 | .S $E(PSULINE,25,32)=$J($P(DOSE(PSUDIV),U,2),8)
|
---|
| 70 | .S $E(PSULINE,33,42)=$J($P(DOSE(PSUDIV),U,3),10)
|
---|
| 71 | .S $E(PSULINE,44,45)="$"
|
---|
| 72 | .S $E(PSULINE,46,53)=$J($P(DOSE(PSUDIV),U,4),8)
|
---|
| 73 | .S $E(PSULINE,57,58)="$"
|
---|
| 74 | .S $E(PSULINE,59,64)=$J($P(DOSE(PSUDIV),U,5),6)
|
---|
| 75 | .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
|
---|
| 76 | Q
|
---|
| 77 | ;
|
---|
| 78 | DOST ;Set dose totals into array and set into message
|
---|
| 79 | ;
|
---|
| 80 | M DOSTOT=^XTMP(PSUUDSUB,"DOSTOT")
|
---|
| 81 | I '$G(DOSTOT) S DOSTOT="0^0^0^0^0"
|
---|
| 82 | ;
|
---|
| 83 | S PSULINE=""
|
---|
| 84 | S $E(PSULINE,1,17)="Total"
|
---|
| 85 | S $E(PSULINE,18,24)=$J($P(DOSTOT,U,1),7)
|
---|
| 86 | S $E(PSULINE,25,32)=$J($P(DOSTOT,U,2),8)
|
---|
| 87 | S $E(PSULINE,33,42)=$J($P(DOSTOT,U,3),10)
|
---|
| 88 | S $E(PSULINE,44,45)="$"
|
---|
| 89 | S $E(PSULINE,46,53)=$J($P(DOSTOT,U,4),8)
|
---|
| 90 | S $E(PSULINE,57,58)="$"
|
---|
| 91 | S $E(PSULINE,59,64)=$J($P(DOSTOT,U,5),6)
|
---|
| 92 | S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
|
---|
| 93 | Q
|
---|
| 94 | ;
|
---|
| 95 | DIV ;Set division data into array and create message
|
---|
| 96 | ;
|
---|
| 97 | M SPEC=^XTMP(PSUUDSUB,"SPEC")
|
---|
| 98 | ;
|
---|
| 99 | ;
|
---|
| 100 | S PSUDV=0
|
---|
| 101 | F S PSUDV=$O(SPEC(PSUDV)) Q:PSUDV="" D
|
---|
| 102 | .S X=PSUDV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
|
---|
| 103 | .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
---|
| 104 | .S PSUSPC=0
|
---|
| 105 | .N C
|
---|
| 106 | .F S PSUSPC=$O(SPEC(PSUDV,PSUSPC)) Q:PSUSPC="" D
|
---|
| 107 | ..S PSULINE=""
|
---|
| 108 | ..I '$D(C) S $E(PSULINE,1,17)=PSUDIVNM S C=""
|
---|
| 109 | ..S $E(PSULINE,25,49)=$P(SPEC(PSUDV,PSUSPC),U,1)
|
---|
| 110 | ..S $E(PSULINE,50,59)=$J($P(SPEC(PSUDV,PSUSPC),U,2),10)
|
---|
| 111 | ..S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
|
---|
| 112 | .D DIVTOT
|
---|
| 113 | Q
|
---|
| 114 | ;
|
---|
| 115 | DIVTOT ;Create message lines for division totals
|
---|
| 116 | ;
|
---|
| 117 | S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
|
---|
| 118 | ;
|
---|
| 119 | S PSULINE=""
|
---|
| 120 | S $E(PSULINE,1,40)=PSUDIVNM_" Total"
|
---|
| 121 | S $E(PSULINE,50,59)=$J(^XTMP(PSUUDSUB,"DIVTOT",PSUDV),10)
|
---|
| 122 | S AMIS(PSULN)=PSULINE
|
---|
| 123 | ;
|
---|
| 124 | S PSULN=PSULN+1
|
---|
| 125 | ;
|
---|
| 126 | F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
|
---|
| 127 | S PSULN=PSULN+1
|
---|
| 128 | Q
|
---|
| 129 | ;
|
---|
| 130 | GTOT ;Calculate grand total patient days of care for all divisions
|
---|
| 131 | ;
|
---|
| 132 | S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
|
---|
| 133 | ;
|
---|
| 134 | S PSULINE=""
|
---|
| 135 | S $E(PSULINE,1,40)="Grand Total"
|
---|
| 136 | S $E(PSULINE,50,59)=$J($G(^XTMP(PSUUDSUB,"GTOT")),10)
|
---|
| 137 | S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
|
---|
| 138 | ;
|
---|
| 139 | ;
|
---|
| 140 | Q
|
---|
| 141 | ;
|
---|
| 142 | MAIL ;Send mailman message
|
---|
| 143 | ;
|
---|
| 144 | ;Do not send report if option selection includes 1,2,3,4,6
|
---|
| 145 | I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
|
---|
| 146 | .M ^XTMP("PSU_"_PSUJOB,"UDCOMBO")=AMIS
|
---|
| 147 | .S ^XTMP("PSU_"_PSUJOB,"UDCOMBO",1)="INPATIENT:"
|
---|
| 148 | ;
|
---|
| 149 | S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
|
---|
| 150 | S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
|
---|
| 151 | ;
|
---|
| 152 | S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
|
---|
| 153 | S XMTEXT="AMIS("
|
---|
| 154 | S XMDUZ=DUZ
|
---|
| 155 | M XMY=PSUXMY
|
---|
| 156 | S XMCHAN=1
|
---|
| 157 | I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
|
---|
| 158 | ;
|
---|
| 159 | Q
|
---|