PSUAR7 ;BIR/DAM - PBM AR/WS AMIS SUMMARY MESSAGE;15 APR 2004
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;
;Reference to file #40.8 supported by DBIA 2438
;
EN ;Entry point to create AMIS summary report
;Called from ^PSUAR6
;
D DOSES
Q:'$D(^XTMP(PSUARSUB,"DIV_CAT")) ;QUIT IF NO DATA
D UNITS
D FLDS
D BLD
F PSULN=PSULN:1:(PSULN+3) S AMISAR(PSULN)="" ;Blank lines
D MAIL
;
Q
;
;
DOSES ;Construct DOSES lines for the MailMan message
;
S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
;
K AMISAR ;Array to hold message lines
;
S AMISAR(1)="Automatic Replenishment/Ward Stock AMIS Summary"
;
S AMISAR(2)=PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
;
S AMISAR(3)="" ;Blank line
;
I '$D(^XTMP(PSUARSUB,"DIV_CAT")) D G MAIL ;NO DATA REPORT
.S AMISAR(3)=" "
.S AMISAR(4)="No data to report"
.S AMISAR(5)=" "
;
S AMISAR(4)="AR/WS DOSES:"
;
S AMISAR(5)=" DOSES DOSES NET DOSES TOTAL AVE COST"
S AMISAR(6)="DIVISION DISPENSED RETURNED DISPENSED COST PER DOSE"
;
S $P(AMISAR(7),"-",78)="" ;Separator bar
;
S PSULN=8
;
S PSUDIV=0
F S PSUDIV=$O(PSUAR("DSP",PSUDIV)) Q:PSUDIV="" D
.S PSULINE=""
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S $E(PSULINE,1,17)=$G(PSUDIVNM)
.I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
.S $E(PSULINE,19,29)=$J($P(PSUAR("DSP",PSUDIV),U,1),11)
.S $E(PSULINE,30,39)=$J($P(PSUAR("DSP",PSUDIV),U,2),10)
.S $E(PSULINE,40,50)=$J($P(PSUAR("DSP",PSUDIV),U,3),11)
.S $E(PSULINE,53,54)="$"
.S $E(PSULINE,55,65)=$J($P(PSUAR("DSP",PSUDIV),U,4),11)
.S $E(PSULINE,70,71)="$"
.S $E(PSULINE,72,78)=$J($P(PSUAR("DSP",PSUDIV),U,5),7)
.S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
S PSULN=PSULN+1
;
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,19,29)=$J($P(TOTAL("DSP"),U,1),11)
S $E(PSULINE,30,39)=$J($P(TOTAL("DSP"),U,2),10)
S $E(PSULINE,40,50)=$J($P(TOTAL("DSP"),U,3),11)
S $E(PSULINE,53,54)="$"
S $E(PSULINE,55,65)=$J($P(TOTAL("DSP"),U,4),11)
S $E(PSULINE,70,71)="$"
S $E(PSULINE,72,78)=$J($P(TOTAL("DSP"),U,5),7)
S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
Q
;
UNITS ;Construct DOSES lines for the MailMan message
;
F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
S PSULN=PSULN+1
;
S AMISAR(PSULN)="AR/WS UNITS:"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" UNITS UNITS NET UNITS TOTAL AVE COST"
S PSULN=PSULN+1
;
S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER UNIT"
S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
;
S PSULN=PSULN+1
;
S PSUDIV=0
F S PSUDIV=$O(PSUAR("UNIT",PSUDIV)) Q:PSUDIV="" D
.S PSULINE=""
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S $E(PSULINE,1,17)=$G(PSUDIVNM)
.I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
.S $E(PSULINE,19,29)=$J($P(PSUAR("UNIT",PSUDIV),U,1),11)
.S $E(PSULINE,30,39)=$J($P(PSUAR("UNIT",PSUDIV),U,2),10)
.S $E(PSULINE,40,50)=$J($P(PSUAR("UNIT",PSUDIV),U,3),11)
.S $E(PSULINE,53,54)="$"
.S $E(PSULINE,55,65)=$J($P(PSUAR("UNIT",PSUDIV),U,4),11)
.S $E(PSULINE,70,71)="$"
.S $E(PSULINE,72,78)=$J($P(PSUAR("UNIT",PSUDIV),U,5),7)
.S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
S PSULN=PSULN+1
;
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,19,29)=$J($P(TOTAL("UNIT"),U,1),11)
S $E(PSULINE,30,39)=$J($P(TOTAL("UNIT"),U,2),10)
S $E(PSULINE,40,50)=$J($P(TOTAL("UNIT"),U,3),11)
S $E(PSULINE,53,54)="$"
S $E(PSULINE,55,65)=$J($P(TOTAL("UNIT"),U,4),11)
S $E(PSULINE,70,71)="$"
S $E(PSULINE,72,78)=$J($P(TOTAL("UNIT"),U,5),7)
S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
Q
;
FLDS ;Compose lines for FLUIDS/SETS portion of message
;
F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
S PSULN=PSULN+1
;
S AMISAR(PSULN)="FLUIDS/SETS:"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" NET"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" FLUIDS/SETS FLUIDS/SETS FLUIDS/SETS TOTAL AVE COST"
S PSULN=PSULN+1
;
S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" FLUIDS/SETS"
S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
;
S PSULN=PSULN+1
;
S PSUDIV=0
F S PSUDIV=$O(PSUAR("FLD",PSUDIV)) Q:PSUDIV="" D
.S PSULINE=""
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S $E(PSULINE,1,17)=$G(PSUDIVNM)
.I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
.S $E(PSULINE,19,29)=$J($P(PSUAR("FLD",PSUDIV),U,1),11)
.S $E(PSULINE,30,39)=$J($P(PSUAR("FLD",PSUDIV),U,2),10)
.S $E(PSULINE,40,50)=$J($P(PSUAR("FLD",PSUDIV),U,3),11)
.S $E(PSULINE,53,54)="$"
.S $E(PSULINE,55,65)=$J($P(PSUAR("FLD",PSUDIV),U,4),11)
.S $E(PSULINE,70,71)="$"
.S $E(PSULINE,72,78)=$J($P(PSUAR("FLD",PSUDIV),U,5),7)
.S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
S PSULN=PSULN+1
;
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,19,29)=$J($P(TOTAL("FLD"),U,1),11)
S $E(PSULINE,30,39)=$J($P(TOTAL("FLD"),U,2),10)
S $E(PSULINE,40,50)=$J($P(TOTAL("FLD"),U,3),11)
S $E(PSULINE,53,54)="$"
S $E(PSULINE,55,65)=$J($P(TOTAL("FLD"),U,4),11)
S $E(PSULINE,70,71)="$"
S $E(PSULINE,72,78)=$J($P(TOTAL("FLD"),U,5),7)
S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
Q
;
BLD ;Compose lines for BLOOD PRODUCTS portion of message
;
F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
S PSULN=PSULN+1
;
S AMISAR(PSULN)="BLOOD PRODUCTS"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" NET"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" BLOOD PROD BLOOD PROD BLOOD PROD TOTAL AVE COST"
S PSULN=PSULN+1
;
S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
S PSULN=PSULN+1
;
S AMISAR(PSULN)=" BLOOD PROD"
S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
;
S PSULN=PSULN+1
;
S PSUDIV=0
F S PSUDIV=$O(PSUAR("BLD",PSUDIV)) Q:PSUDIV="" D
.S PSULINE=""
.S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
.S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
.S $E(PSULINE,1,17)=$G(PSUDIVNM)
.I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
.S $E(PSULINE,19,29)=$J($P(PSUAR("BLD",PSUDIV),U,1),11)
.S $E(PSULINE,30,39)=$J($P(PSUAR("BLD",PSUDIV),U,2),10)
.S $E(PSULINE,40,50)=$J($P(PSUAR("BLD",PSUDIV),U,3),11)
.S $E(PSULINE,53,54)="$"
.S $E(PSULINE,55,65)=$J($P(PSUAR("BLD",PSUDIV),U,4),11)
.S $E(PSULINE,70,71)="$"
.S $E(PSULINE,72,78)=$J($P(PSUAR("BLD",PSUDIV),U,5),7)
.S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
S PSULN=PSULN+1
;
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,19,29)=$J($P(TOTAL("BLD"),U,1),11)
S $E(PSULINE,30,39)=$J($P(TOTAL("BLD"),U,2),10)
S $E(PSULINE,40,50)=$J($P(TOTAL("BLD"),U,3),11)
S $E(PSULINE,53,54)="$"
S $E(PSULINE,55,65)=$J($P(TOTAL("BLD"),U,4),11)
S $E(PSULINE,70,71)="$"
S $E(PSULINE,72,78)=$J($P(TOTAL("BLD"),U,5),7)
S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
;
Q
;
;
;
MAIL ;Mail CS AMIS summary report
;
;Do not send report if option selection includes 1,2,3,4,6
I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
.M ^XTMP("PSU_"_PSUJOB,"ARCOMBO")=AMISAR
.S ^XTMP("PSU_"_PSUJOB,"ARCOMBO",1)=""
.S ^XTMP("PSU_"_PSUJOB,"ARCOMBO",2)=""
;
M XMY=PSUXMYS2
;
S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
;
S XMSUB="V. 4.0 PBMAR "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
S XMTEXT="AMISAR("
M ^XTMP("PSU_"_PSUJOB,"ARAMIS")=AMISAR
S XMCHAN=1
D ^XMD
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUAR7 8224 printed Oct 16, 2024@18:28:10 Page 2
PSUAR7 ;BIR/DAM - PBM AR/WS AMIS SUMMARY MESSAGE;15 APR 2004
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;
+3 ;Reference to file #40.8 supported by DBIA 2438
+4 ;
EN ;Entry point to create AMIS summary report
+1 ;Called from ^PSUAR6
+2 ;
+3 DO DOSES
+4 ;QUIT IF NO DATA
if '$DATA(^XTMP(PSUARSUB,"DIV_CAT"))
QUIT
+5 DO UNITS
+6 DO FLDS
+7 DO BLD
+8 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+3)
SET AMISAR(PSULN)=""
+9 DO MAIL
+10 ;
+11 QUIT
+12 ;
+13 ;
DOSES ;Construct DOSES lines for the MailMan message
+1 ;
+2 ; start date
SET Y=PSUSDT\1
XECUTE ^DD("DD")
SET PSUDTS=Y
+3 ; end date
SET Y=PSUEDT\1
XECUTE ^DD("DD")
SET PSUDTE=Y
+4 ;
+5 ;Array to hold message lines
KILL AMISAR
+6 ;
+7 SET AMISAR(1)="Automatic Replenishment/Ward Stock AMIS Summary"
+8 ;
+9 SET AMISAR(2)=PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+10 ;
+11 ;Blank line
SET AMISAR(3)=""
+12 ;
+13 ;NO DATA REPORT
IF '$DATA(^XTMP(PSUARSUB,"DIV_CAT"))
Begin DoDot:1
+14 SET AMISAR(3)=" "
+15 SET AMISAR(4)="No data to report"
+16 SET AMISAR(5)=" "
End DoDot:1
GOTO MAIL
+17 ;
+18 SET AMISAR(4)="AR/WS DOSES:"
+19 ;
+20 SET AMISAR(5)=" DOSES DOSES NET DOSES TOTAL AVE COST"
+21 SET AMISAR(6)="DIVISION DISPENSED RETURNED DISPENSED COST PER DOSE"
+22 ;
+23 ;Separator bar
SET $PIECE(AMISAR(7),"-",78)=""
+24 ;
+25 SET PSULN=8
+26 ;
+27 SET PSUDIV=0
+28 FOR
SET PSUDIV=$ORDER(PSUAR("DSP",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+29 SET PSULINE=""
+30 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+31 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+32 SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIVNM)
+33 IF PSUDIVNM=""
SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIV)
+34 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(PSUAR("DSP",PSUDIV),U,1),11)
+35 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(PSUAR("DSP",PSUDIV),U,2),10)
+36 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(PSUAR("DSP",PSUDIV),U,3),11)
+37 SET $EXTRACT(PSULINE,53,54)="$"
+38 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(PSUAR("DSP",PSUDIV),U,4),11)
+39 SET $EXTRACT(PSULINE,70,71)="$"
+40 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(PSUAR("DSP",PSUDIV),U,5),7)
+41 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+42 ;
+43 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+44 SET PSULN=PSULN+1
+45 ;
+46 SET PSULINE=""
+47 SET $EXTRACT(PSULINE,1,17)="Total"
+48 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(TOTAL("DSP"),U,1),11)
+49 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(TOTAL("DSP"),U,2),10)
+50 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(TOTAL("DSP"),U,3),11)
+51 SET $EXTRACT(PSULINE,53,54)="$"
+52 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(TOTAL("DSP"),U,4),11)
+53 SET $EXTRACT(PSULINE,70,71)="$"
+54 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(TOTAL("DSP"),U,5),7)
+55 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
+56 ;
+57 QUIT
+58 ;
UNITS ;Construct DOSES lines for the MailMan message
+1 ;
+2 FOR PSULN=PSULN:1:(PSULN+1)
SET AMISAR(PSULN)=""
+3 SET PSULN=PSULN+1
+4 ;
+5 SET AMISAR(PSULN)="AR/WS UNITS:"
+6 SET PSULN=PSULN+1
+7 ;
+8 SET AMISAR(PSULN)=" UNITS UNITS NET UNITS TOTAL AVE COST"
+9 SET PSULN=PSULN+1
+10 ;
+11 SET AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER UNIT"
+12 SET PSULN=PSULN+1
+13 ;
+14 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+15 ;
+16 SET PSULN=PSULN+1
+17 ;
+18 SET PSUDIV=0
+19 FOR
SET PSUDIV=$ORDER(PSUAR("UNIT",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+20 SET PSULINE=""
+21 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+22 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+23 SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIVNM)
+24 IF PSUDIVNM=""
SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIV)
+25 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(PSUAR("UNIT",PSUDIV),U,1),11)
+26 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(PSUAR("UNIT",PSUDIV),U,2),10)
+27 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(PSUAR("UNIT",PSUDIV),U,3),11)
+28 SET $EXTRACT(PSULINE,53,54)="$"
+29 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(PSUAR("UNIT",PSUDIV),U,4),11)
+30 SET $EXTRACT(PSULINE,70,71)="$"
+31 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(PSUAR("UNIT",PSUDIV),U,5),7)
+32 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+33 ;
+34 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+35 SET PSULN=PSULN+1
+36 ;
+37 SET PSULINE=""
+38 SET $EXTRACT(PSULINE,1,17)="Total"
+39 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(TOTAL("UNIT"),U,1),11)
+40 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(TOTAL("UNIT"),U,2),10)
+41 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(TOTAL("UNIT"),U,3),11)
+42 SET $EXTRACT(PSULINE,53,54)="$"
+43 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(TOTAL("UNIT"),U,4),11)
+44 SET $EXTRACT(PSULINE,70,71)="$"
+45 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(TOTAL("UNIT"),U,5),7)
+46 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
+47 ;
+48 QUIT
+49 ;
FLDS ;Compose lines for FLUIDS/SETS portion of message
+1 ;
+2 FOR PSULN=PSULN:1:(PSULN+1)
SET AMISAR(PSULN)=""
+3 SET PSULN=PSULN+1
+4 ;
+5 SET AMISAR(PSULN)="FLUIDS/SETS:"
+6 SET PSULN=PSULN+1
+7 ;
+8 SET AMISAR(PSULN)=" NET"
+9 SET PSULN=PSULN+1
+10 ;
+11 SET AMISAR(PSULN)=" FLUIDS/SETS FLUIDS/SETS FLUIDS/SETS TOTAL AVE COST"
+12 SET PSULN=PSULN+1
+13 ;
+14 SET AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
+15 SET PSULN=PSULN+1
+16 ;
+17 SET AMISAR(PSULN)=" FLUIDS/SETS"
+18 SET PSULN=PSULN+1
+19 ;
+20 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+21 ;
+22 SET PSULN=PSULN+1
+23 ;
+24 SET PSUDIV=0
+25 FOR
SET PSUDIV=$ORDER(PSUAR("FLD",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+26 SET PSULINE=""
+27 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+28 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+29 SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIVNM)
+30 IF PSUDIVNM=""
SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIV)
+31 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(PSUAR("FLD",PSUDIV),U,1),11)
+32 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(PSUAR("FLD",PSUDIV),U,2),10)
+33 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(PSUAR("FLD",PSUDIV),U,3),11)
+34 SET $EXTRACT(PSULINE,53,54)="$"
+35 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(PSUAR("FLD",PSUDIV),U,4),11)
+36 SET $EXTRACT(PSULINE,70,71)="$"
+37 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(PSUAR("FLD",PSUDIV),U,5),7)
+38 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+39 ;
+40 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+41 SET PSULN=PSULN+1
+42 ;
+43 SET PSULINE=""
+44 SET $EXTRACT(PSULINE,1,17)="Total"
+45 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(TOTAL("FLD"),U,1),11)
+46 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(TOTAL("FLD"),U,2),10)
+47 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(TOTAL("FLD"),U,3),11)
+48 SET $EXTRACT(PSULINE,53,54)="$"
+49 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(TOTAL("FLD"),U,4),11)
+50 SET $EXTRACT(PSULINE,70,71)="$"
+51 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(TOTAL("FLD"),U,5),7)
+52 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
+53 ;
+54 QUIT
+55 ;
BLD ;Compose lines for BLOOD PRODUCTS portion of message
+1 ;
+2 FOR PSULN=PSULN:1:(PSULN+1)
SET AMISAR(PSULN)=""
+3 SET PSULN=PSULN+1
+4 ;
+5 SET AMISAR(PSULN)="BLOOD PRODUCTS"
+6 SET PSULN=PSULN+1
+7 ;
+8 SET AMISAR(PSULN)=" NET"
+9 SET PSULN=PSULN+1
+10 ;
+11 SET AMISAR(PSULN)=" BLOOD PROD BLOOD PROD BLOOD PROD TOTAL AVE COST"
+12 SET PSULN=PSULN+1
+13 ;
+14 SET AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
+15 SET PSULN=PSULN+1
+16 ;
+17 SET AMISAR(PSULN)=" BLOOD PROD"
+18 SET PSULN=PSULN+1
+19 ;
+20 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+21 ;
+22 SET PSULN=PSULN+1
+23 ;
+24 SET PSUDIV=0
+25 FOR
SET PSUDIV=$ORDER(PSUAR("BLD",PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+26 SET PSULINE=""
+27 SET X=PSUDIV
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+28 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+29 SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIVNM)
+30 IF PSUDIVNM=""
SET $EXTRACT(PSULINE,1,17)=$GET(PSUDIV)
+31 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(PSUAR("BLD",PSUDIV),U,1),11)
+32 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(PSUAR("BLD",PSUDIV),U,2),10)
+33 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(PSUAR("BLD",PSUDIV),U,3),11)
+34 SET $EXTRACT(PSULINE,53,54)="$"
+35 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(PSUAR("BLD",PSUDIV),U,4),11)
+36 SET $EXTRACT(PSULINE,70,71)="$"
+37 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(PSUAR("BLD",PSUDIV),U,5),7)
+38 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+39 ;
+40 ;Separator bar
SET $PIECE(AMISAR(PSULN),"-",78)=""
+41 SET PSULN=PSULN+1
+42 ;
+43 SET PSULINE=""
+44 SET $EXTRACT(PSULINE,1,17)="Total"
+45 SET $EXTRACT(PSULINE,19,29)=$JUSTIFY($PIECE(TOTAL("BLD"),U,1),11)
+46 SET $EXTRACT(PSULINE,30,39)=$JUSTIFY($PIECE(TOTAL("BLD"),U,2),10)
+47 SET $EXTRACT(PSULINE,40,50)=$JUSTIFY($PIECE(TOTAL("BLD"),U,3),11)
+48 SET $EXTRACT(PSULINE,53,54)="$"
+49 SET $EXTRACT(PSULINE,55,65)=$JUSTIFY($PIECE(TOTAL("BLD"),U,4),11)
+50 SET $EXTRACT(PSULINE,70,71)="$"
+51 SET $EXTRACT(PSULINE,72,78)=$JUSTIFY($PIECE(TOTAL("BLD"),U,5),7)
+52 SET AMISAR(PSULN)=PSULINE
SET PSULN=PSULN+1
+53 ;
+54 QUIT
+55 ;
+56 ;
+57 ;
MAIL ;Mail CS AMIS summary report
+1 ;
+2 ;Do not send report if option selection includes 1,2,3,4,6
+3 IF $DATA(^XTMP("PSU_"_PSUJOB,"CBAMIS"))
Begin DoDot:1
+4 MERGE ^XTMP("PSU_"_PSUJOB,"ARCOMBO")=AMISAR
+5 SET ^XTMP("PSU_"_PSUJOB,"ARCOMBO",1)=""
+6 SET ^XTMP("PSU_"_PSUJOB,"ARCOMBO",2)=""
End DoDot:1
QUIT
+7 ;
+8 MERGE XMY=PSUXMYS2
+9 ;
+10 SET X=PSUSNDR
SET DIC=40.8
SET DIC(0)="X"
SET D="C"
DO IX^DIC
+11 SET X=+Y
SET PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
+12 ;
+13 SET XMSUB="V. 4.0 PBMAR "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
+14 SET XMTEXT="AMISAR("
+15 MERGE ^XTMP("PSU_"_PSUJOB,"ARAMIS")=AMISAR
+16 SET XMCHAN=1
+17 DO ^XMD
+18 ;
+19 QUIT
