- 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 Mar 13, 2025@21:31:55 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
