PSUV12 ;BIR/DAM - IV AMIS Summary Message II ;04 MAR 2004
;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
;
;No DBIA's required
;
EN ;Entry point for MailMan message
;Called from PSUV11
;
;Construct IV AMIS summary message
;
S Y=PSUSDT X ^DD("DD") S PSUDTS=Y
S Y=PSUEDT X ^DD("DD") S PSUDTE=Y
S PSUDIV=PSUSNDR D GETDIV^PSUV3
S AMIS(1)="IV AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
;
S AMIS(2)="" ;Blank line
;
I PSUAIS=1 S AMIS(3)="NO IV AMIS Summary data to report" Q
;
S AMIS(3)=" NET Cost/"
;
S AMIS(4)=" LVPs LVPs LVPs LVPs LVPs Total NET LVPs"
;
S AMIS(5)="Division DISP RET DES CAN DISP Cost DISP"
;
S $P(AMIS(6),"-",78)="" ;Separator bar
;
S PSULN=7
;
;Construct LVP DATA lines with spacing
S PSUDIV=0
F S PSUDIV=$O(LVP(PSUDIV)) Q:PSUDIV="" D
.D GETDIV^PSUV3
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(LVP(PSUDIV),U,1),7)
.S $E(PSULINE,25,31)=$J($P(LVP(PSUDIV),U,2),7)
.S $E(PSULINE,32,38)=$J($P(LVP(PSUDIV),U,3),7)
.S $E(PSULINE,39,45)=$J($P(LVP(PSUDIV),U,4),7)
.S $E(PSULINE,46,52)=$J($P(LVP(PSUDIV),U,5),7)
.S $E(PSULINE,54,55)="$"
.S $E(PSULINE,56,64)=$J($P(LVP(PSUDIV),U,6),9)
.S $E(PSULINE,66,67)="$"
.S $E(PSULINE,68,75)=$J($P(LVP(PSUDIV),U,7),8)
.;End line
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
M LVP("TOT")=^XTMP(PSUIVSUB,"LVPTOT") ;LVP Totals array
;Construct LVP Totals line
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(LVP("TOT"),U,1),7)
S $E(PSULINE,25,31)=$J($P(LVP("TOT"),U,2),7)
S $E(PSULINE,32,38)=$J($P(LVP("TOT"),U,3),7)
S $E(PSULINE,39,45)=$J($P(LVP("TOT"),U,4),7)
S $E(PSULINE,46,52)=$J($P(LVP("TOT"),U,5),7)
S $E(PSULINE,54,55)="$"
S $E(PSULINE,56,64)=$J($P(LVP("TOT"),U,6),9)
S $E(PSULINE,66,67)="$"
S $E(PSULINE,68,75)=$J($P(LVP("TOT"),U,7),8)
;End line
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
;
;
S AMIS(PSULN)=" NET Cost/"
S PSULN=PSULN+1
;
S AMIS(PSULN)=" IVPBs IVPBs IVPBs IVPBs IVPBs Total NET IVPBs"
;
S PSULN=PSULN+1
S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
;
S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
;Construct IVPB DATA lines with spacing
S PSUDIV=0
F S PSUDIV=$O(PB(PSUDIV)) Q:PSUDIV="" D
.D GETDIV^PSUV3
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(PB(PSUDIV),U,1),7)
.S $E(PSULINE,25,31)=$J($P(PB(PSUDIV),U,2),7)
.S $E(PSULINE,32,38)=$J($P(PB(PSUDIV),U,3),7)
.S $E(PSULINE,39,45)=$J($P(PB(PSUDIV),U,4),7)
.S $E(PSULINE,46,52)=$J($P(PB(PSUDIV),U,5),7)
.S $E(PSULINE,54,55)="$"
.S $E(PSULINE,56,64)=$J($P(PB(PSUDIV),U,6),9)
.S $E(PSULINE,66,67)="$"
.S $E(PSULINE,68,75)=$J($P(PB(PSUDIV),U,7),8)
.;End line
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
M PB("TOT")=^XTMP(PSUIVSUB,"PBTOT") ;IVPB Totals array
;Construct PB Totals line
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(PB("TOT"),U,1),7)
S $E(PSULINE,25,31)=$J($P(PB("TOT"),U,2),7)
S $E(PSULINE,32,38)=$J($P(PB("TOT"),U,3),7)
S $E(PSULINE,39,45)=$J($P(PB("TOT"),U,4),7)
S $E(PSULINE,46,52)=$J($P(PB("TOT"),U,5),7)
S $E(PSULINE,54,55)="$"
S $E(PSULINE,56,64)=$J($P(PB("TOT"),U,6),9)
S $E(PSULINE,66,67)="$"
S $E(PSULINE,68,75)=$J($P(PB("TOT"),U,7),8)
;End line
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
;
S AMIS(PSULN)=" NET Cost/"
S PSULN=PSULN+1
;
S AMIS(PSULN)=" TPNs TPNs TPNs TPNs TPNs Total NET TPNs"
;
S PSULN=PSULN+1
S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
;
S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
;Construct TPN DATA lines with spacing
S PSUDIV=0
F S PSUDIV=$O(TPN(PSUDIV)) Q:PSUDIV="" D
.D GETDIV^PSUV3
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(TPN(PSUDIV),U,1),7)
.S $E(PSULINE,25,31)=$J($P(TPN(PSUDIV),U,2),7)
.S $E(PSULINE,32,38)=$J($P(TPN(PSUDIV),U,3),7)
.S $E(PSULINE,39,45)=$J($P(TPN(PSUDIV),U,4),7)
.S $E(PSULINE,46,52)=$J($P(TPN(PSUDIV),U,5),7)
.S $E(PSULINE,54,55)="$"
.S $E(PSULINE,56,64)=$J($P(TPN(PSUDIV),U,6),9)
.S $E(PSULINE,66,67)="$"
.S $E(PSULINE,68,75)=$J($P(TPN(PSUDIV),U,7),8)
.;End line
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
M TPN("TOT")=^XTMP(PSUIVSUB,"TPNTOT") ;TPN Totals array
;Construct TPN Totals line
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(TPN("TOT"),U,1),7)
S $E(PSULINE,25,31)=$J($P(TPN("TOT"),U,2),7)
S $E(PSULINE,32,38)=$J($P(TPN("TOT"),U,3),7)
S $E(PSULINE,39,45)=$J($P(TPN("TOT"),U,4),7)
S $E(PSULINE,46,52)=$J($P(TPN("TOT"),U,5),7)
S $E(PSULINE,54,55)="$"
S $E(PSULINE,56,64)=$J($P(TPN("TOT"),U,6),9)
S $E(PSULINE,66,67)="$"
S $E(PSULINE,68,75)=$J($P(TPN("TOT"),U,7),8)
;End line
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
;
S AMIS(PSULN)=" NET Cost/"
S PSULN=PSULN+1
;
S AMIS(PSULN)=" CHEMO CHEMO CHEMO CHEMO CHEMO Total NET CHEMOs"
;
S PSULN=PSULN+1
S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
;
S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
;Construct CHEMO DATA lines with spacing
S PSUDIV=0
F S PSUDIV=$O(CH(PSUDIV)) Q:PSUDIV="" D
.D GETDIV^PSUV3
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(CH(PSUDIV),U,1),7)
.S $E(PSULINE,25,31)=$J($P(CH(PSUDIV),U,2),7)
.S $E(PSULINE,32,38)=$J($P(CH(PSUDIV),U,3),7)
.S $E(PSULINE,39,45)=$J($P(CH(PSUDIV),U,4),7)
.S $E(PSULINE,46,52)=$J($P(CH(PSUDIV),U,5),7)
.S $E(PSULINE,54,55)="$"
.S $E(PSULINE,56,64)=$J($P(CH(PSUDIV),U,6),9)
.S $E(PSULINE,66,67)="$"
.S $E(PSULINE,68,75)=$J($P(CH(PSUDIV),U,7),8)
.;End line
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
M CH("TOT")=^XTMP(PSUIVSUB,"CHTOT") ;CHEMO Totals array
;Construct CHEMO Totals line
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(CH("TOT"),U,1),7)
S $E(PSULINE,25,31)=$J($P(CH("TOT"),U,2),7)
S $E(PSULINE,32,38)=$J($P(CH("TOT"),U,3),7)
S $E(PSULINE,39,45)=$J($P(CH("TOT"),U,4),7)
S $E(PSULINE,46,52)=$J($P(CH("TOT"),U,5),7)
S $E(PSULINE,54,55)="$"
S $E(PSULINE,56,64)=$J($P(CH("TOT"),U,6),9)
S $E(PSULINE,66,67)="$"
S $E(PSULINE,68,75)=$J($P(CH("TOT"),U,7),8)
;End line
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
;
;
S AMIS(PSULN)=" NET Cost/"
S PSULN=PSULN+1
;
S AMIS(PSULN)=" SYRs SYRs SYRs SYRs SYRs Total NET SYRs"
;
S PSULN=PSULN+1
S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
;
S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
;Construct SYRINGE DATA lines with spacing
S PSUDIV=0
F S PSUDIV=$O(SYR(PSUDIV)) Q:PSUDIV="" D
.D GETDIV^PSUV3
.S PSULINE=""
.S $E(PSULINE,1,17)=PSUDIVNM
.S $E(PSULINE,18,24)=$J($P(SYR(PSUDIV),U,1),7)
.S $E(PSULINE,25,31)=$J($P(SYR(PSUDIV),U,2),7)
.S $E(PSULINE,32,38)=$J($P(SYR(PSUDIV),U,3),7)
.S $E(PSULINE,39,45)=$J($P(SYR(PSUDIV),U,4),7)
.S $E(PSULINE,46,52)=$J($P(SYR(PSUDIV),U,5),7)
.S $E(PSULINE,54,55)="$"
.S $E(PSULINE,56,64)=$J($P(SYR(PSUDIV),U,6),9)
.S $E(PSULINE,66,67)="$"
.S $E(PSULINE,68,75)=$J($P(SYR(PSUDIV),U,7),8)
.;End line
.S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
;
M SYR("TOT")=^XTMP(PSUIVSUB,"SYRTOT") ;SYRINGE Totals array
;Construct SYRINGE Totals line
S PSULINE=""
S $E(PSULINE,1,17)="Total"
S $E(PSULINE,18,24)=$J($P(SYR("TOT"),U,1),7)
S $E(PSULINE,25,31)=$J($P(SYR("TOT"),U,2),7)
S $E(PSULINE,32,38)=$J($P(SYR("TOT"),U,3),7)
S $E(PSULINE,39,45)=$J($P(SYR("TOT"),U,4),7)
S $E(PSULINE,46,52)=$J($P(SYR("TOT"),U,5),7)
S $E(PSULINE,54,55)="$"
S $E(PSULINE,56,64)=$J($P(SYR("TOT"),U,6),9)
S $E(PSULINE,66,67)="$"
S $E(PSULINE,68,75)=$J($P(SYR("TOT"),U,7),8)
;End line
S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
;
F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
S PSULN=PSULN+1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV12 9264 printed Apr 09, 2024@21:30:26 Page 2
PSUV12 ;BIR/DAM - IV AMIS Summary Message II ;04 MAR 2004
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
+2 ;
+3 ;No DBIA's required
+4 ;
EN ;Entry point for MailMan message
+1 ;Called from PSUV11
+2 ;
+3 ;Construct IV AMIS summary message
+4 ;
+5 SET Y=PSUSDT
XECUTE ^DD("DD")
SET PSUDTS=Y
+6 SET Y=PSUEDT
XECUTE ^DD("DD")
SET PSUDTE=Y
+7 SET PSUDIV=PSUSNDR
DO GETDIV^PSUV3
+8 SET AMIS(1)="IV AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
+9 ;
+10 ;Blank line
SET AMIS(2)=""
+11 ;
+12 IF PSUAIS=1
SET AMIS(3)="NO IV AMIS Summary data to report"
QUIT
+13 ;
+14 SET AMIS(3)=" NET Cost/"
+15 ;
+16 SET AMIS(4)=" LVPs LVPs LVPs LVPs LVPs Total NET LVPs"
+17 ;
+18 SET AMIS(5)="Division DISP RET DES CAN DISP Cost DISP"
+19 ;
+20 ;Separator bar
SET $PIECE(AMIS(6),"-",78)=""
+21 ;
+22 SET PSULN=7
+23 ;
+24 ;Construct LVP DATA lines with spacing
+25 SET PSUDIV=0
+26 FOR
SET PSUDIV=$ORDER(LVP(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+27 DO GETDIV^PSUV3
+28 SET PSULINE=""
+29 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+30 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(LVP(PSUDIV),U,1),7)
+31 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(LVP(PSUDIV),U,2),7)
+32 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(LVP(PSUDIV),U,3),7)
+33 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(LVP(PSUDIV),U,4),7)
+34 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(LVP(PSUDIV),U,5),7)
+35 SET $EXTRACT(PSULINE,54,55)="$"
+36 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(LVP(PSUDIV),U,6),9)
+37 SET $EXTRACT(PSULINE,66,67)="$"
+38 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(LVP(PSUDIV),U,7),8)
+39 ;End line
+40 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+41 ;
+42 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+43 ;
+44 ;LVP Totals array
MERGE LVP("TOT")=^XTMP(PSUIVSUB,"LVPTOT")
+45 ;Construct LVP Totals line
+46 SET PSULINE=""
+47 SET $EXTRACT(PSULINE,1,17)="Total"
+48 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(LVP("TOT"),U,1),7)
+49 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(LVP("TOT"),U,2),7)
+50 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(LVP("TOT"),U,3),7)
+51 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(LVP("TOT"),U,4),7)
+52 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(LVP("TOT"),U,5),7)
+53 SET $EXTRACT(PSULINE,54,55)="$"
+54 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(LVP("TOT"),U,6),9)
+55 SET $EXTRACT(PSULINE,66,67)="$"
+56 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(LVP("TOT"),U,7),8)
+57 ;End line
+58 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+59 ;
+60 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+4)
SET AMIS(PSULN)=""
+61 SET PSULN=PSULN+1
+62 ;
+63 ;
+64 SET AMIS(PSULN)=" NET Cost/"
+65 SET PSULN=PSULN+1
+66 ;
+67 SET AMIS(PSULN)=" IVPBs IVPBs IVPBs IVPBs IVPBs Total NET IVPBs"
+68 ;
+69 SET PSULN=PSULN+1
+70 SET AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
+71 ;
+72 SET PSULN=PSULN+1
+73 ;
+74 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+75 ;
+76 ;Construct IVPB DATA lines with spacing
+77 SET PSUDIV=0
+78 FOR
SET PSUDIV=$ORDER(PB(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+79 DO GETDIV^PSUV3
+80 SET PSULINE=""
+81 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+82 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(PB(PSUDIV),U,1),7)
+83 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(PB(PSUDIV),U,2),7)
+84 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(PB(PSUDIV),U,3),7)
+85 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(PB(PSUDIV),U,4),7)
+86 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(PB(PSUDIV),U,5),7)
+87 SET $EXTRACT(PSULINE,54,55)="$"
+88 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(PB(PSUDIV),U,6),9)
+89 SET $EXTRACT(PSULINE,66,67)="$"
+90 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(PB(PSUDIV),U,7),8)
+91 ;End line
+92 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+93 ;
+94 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+95 ;
+96 ;IVPB Totals array
MERGE PB("TOT")=^XTMP(PSUIVSUB,"PBTOT")
+97 ;Construct PB Totals line
+98 SET PSULINE=""
+99 SET $EXTRACT(PSULINE,1,17)="Total"
+100 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(PB("TOT"),U,1),7)
+101 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(PB("TOT"),U,2),7)
+102 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(PB("TOT"),U,3),7)
+103 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(PB("TOT"),U,4),7)
+104 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(PB("TOT"),U,5),7)
+105 SET $EXTRACT(PSULINE,54,55)="$"
+106 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(PB("TOT"),U,6),9)
+107 SET $EXTRACT(PSULINE,66,67)="$"
+108 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(PB("TOT"),U,7),8)
+109 ;End line
+110 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+111 ;
+112 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+4)
SET AMIS(PSULN)=""
+113 SET PSULN=PSULN+1
+114 ;
+115 SET AMIS(PSULN)=" NET Cost/"
+116 SET PSULN=PSULN+1
+117 ;
+118 SET AMIS(PSULN)=" TPNs TPNs TPNs TPNs TPNs Total NET TPNs"
+119 ;
+120 SET PSULN=PSULN+1
+121 SET AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
+122 ;
+123 SET PSULN=PSULN+1
+124 ;
+125 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+126 ;
+127 ;Construct TPN DATA lines with spacing
+128 SET PSUDIV=0
+129 FOR
SET PSUDIV=$ORDER(TPN(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+130 DO GETDIV^PSUV3
+131 SET PSULINE=""
+132 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+133 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(TPN(PSUDIV),U,1),7)
+134 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(TPN(PSUDIV),U,2),7)
+135 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(TPN(PSUDIV),U,3),7)
+136 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(TPN(PSUDIV),U,4),7)
+137 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(TPN(PSUDIV),U,5),7)
+138 SET $EXTRACT(PSULINE,54,55)="$"
+139 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(TPN(PSUDIV),U,6),9)
+140 SET $EXTRACT(PSULINE,66,67)="$"
+141 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(TPN(PSUDIV),U,7),8)
+142 ;End line
+143 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+144 ;
+145 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+146 ;
+147 ;TPN Totals array
MERGE TPN("TOT")=^XTMP(PSUIVSUB,"TPNTOT")
+148 ;Construct TPN Totals line
+149 SET PSULINE=""
+150 SET $EXTRACT(PSULINE,1,17)="Total"
+151 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(TPN("TOT"),U,1),7)
+152 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(TPN("TOT"),U,2),7)
+153 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(TPN("TOT"),U,3),7)
+154 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(TPN("TOT"),U,4),7)
+155 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(TPN("TOT"),U,5),7)
+156 SET $EXTRACT(PSULINE,54,55)="$"
+157 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(TPN("TOT"),U,6),9)
+158 SET $EXTRACT(PSULINE,66,67)="$"
+159 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(TPN("TOT"),U,7),8)
+160 ;End line
+161 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+162 ;
+163 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+4)
SET AMIS(PSULN)=""
+164 SET PSULN=PSULN+1
+165 ;
+166 SET AMIS(PSULN)=" NET Cost/"
+167 SET PSULN=PSULN+1
+168 ;
+169 SET AMIS(PSULN)=" CHEMO CHEMO CHEMO CHEMO CHEMO Total NET CHEMOs"
+170 ;
+171 SET PSULN=PSULN+1
+172 SET AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
+173 ;
+174 SET PSULN=PSULN+1
+175 ;
+176 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+177 ;
+178 ;Construct CHEMO DATA lines with spacing
+179 SET PSUDIV=0
+180 FOR
SET PSUDIV=$ORDER(CH(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+181 DO GETDIV^PSUV3
+182 SET PSULINE=""
+183 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+184 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(CH(PSUDIV),U,1),7)
+185 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(CH(PSUDIV),U,2),7)
+186 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(CH(PSUDIV),U,3),7)
+187 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(CH(PSUDIV),U,4),7)
+188 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(CH(PSUDIV),U,5),7)
+189 SET $EXTRACT(PSULINE,54,55)="$"
+190 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(CH(PSUDIV),U,6),9)
+191 SET $EXTRACT(PSULINE,66,67)="$"
+192 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(CH(PSUDIV),U,7),8)
+193 ;End line
+194 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+195 ;
+196 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+197 ;
+198 ;CHEMO Totals array
MERGE CH("TOT")=^XTMP(PSUIVSUB,"CHTOT")
+199 ;Construct CHEMO Totals line
+200 SET PSULINE=""
+201 SET $EXTRACT(PSULINE,1,17)="Total"
+202 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(CH("TOT"),U,1),7)
+203 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(CH("TOT"),U,2),7)
+204 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(CH("TOT"),U,3),7)
+205 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(CH("TOT"),U,4),7)
+206 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(CH("TOT"),U,5),7)
+207 SET $EXTRACT(PSULINE,54,55)="$"
+208 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(CH("TOT"),U,6),9)
+209 SET $EXTRACT(PSULINE,66,67)="$"
+210 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(CH("TOT"),U,7),8)
+211 ;End line
+212 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+213 ;
+214 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+4)
SET AMIS(PSULN)=""
+215 SET PSULN=PSULN+1
+216 ;
+217 ;
+218 SET AMIS(PSULN)=" NET Cost/"
+219 SET PSULN=PSULN+1
+220 ;
+221 SET AMIS(PSULN)=" SYRs SYRs SYRs SYRs SYRs Total NET SYRs"
+222 ;
+223 SET PSULN=PSULN+1
+224 SET AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
+225 ;
+226 SET PSULN=PSULN+1
+227 ;
+228 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+229 ;
+230 ;Construct SYRINGE DATA lines with spacing
+231 SET PSUDIV=0
+232 FOR
SET PSUDIV=$ORDER(SYR(PSUDIV))
if PSUDIV=""
QUIT
Begin DoDot:1
+233 DO GETDIV^PSUV3
+234 SET PSULINE=""
+235 SET $EXTRACT(PSULINE,1,17)=PSUDIVNM
+236 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(SYR(PSUDIV),U,1),7)
+237 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(SYR(PSUDIV),U,2),7)
+238 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(SYR(PSUDIV),U,3),7)
+239 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(SYR(PSUDIV),U,4),7)
+240 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(SYR(PSUDIV),U,5),7)
+241 SET $EXTRACT(PSULINE,54,55)="$"
+242 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(SYR(PSUDIV),U,6),9)
+243 SET $EXTRACT(PSULINE,66,67)="$"
+244 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(SYR(PSUDIV),U,7),8)
+245 ;End line
+246 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
End DoDot:1
+247 ;
+248 ;Separator bar
SET $PIECE(AMIS(PSULN),"-",78)=""
SET PSULN=PSULN+1
+249 ;
+250 ;SYRINGE Totals array
MERGE SYR("TOT")=^XTMP(PSUIVSUB,"SYRTOT")
+251 ;Construct SYRINGE Totals line
+252 SET PSULINE=""
+253 SET $EXTRACT(PSULINE,1,17)="Total"
+254 SET $EXTRACT(PSULINE,18,24)=$JUSTIFY($PIECE(SYR("TOT"),U,1),7)
+255 SET $EXTRACT(PSULINE,25,31)=$JUSTIFY($PIECE(SYR("TOT"),U,2),7)
+256 SET $EXTRACT(PSULINE,32,38)=$JUSTIFY($PIECE(SYR("TOT"),U,3),7)
+257 SET $EXTRACT(PSULINE,39,45)=$JUSTIFY($PIECE(SYR("TOT"),U,4),7)
+258 SET $EXTRACT(PSULINE,46,52)=$JUSTIFY($PIECE(SYR("TOT"),U,5),7)
+259 SET $EXTRACT(PSULINE,54,55)="$"
+260 SET $EXTRACT(PSULINE,56,64)=$JUSTIFY($PIECE(SYR("TOT"),U,6),9)
+261 SET $EXTRACT(PSULINE,66,67)="$"
+262 SET $EXTRACT(PSULINE,68,75)=$JUSTIFY($PIECE(SYR("TOT"),U,7),8)
+263 ;End line
+264 SET AMIS(PSULN)=PSULINE
SET PSULN=PSULN+1
+265 ;
+266 ;Blank lines
FOR PSULN=PSULN:1:(PSULN+4)
SET AMIS(PSULN)=""
+267 SET PSULN=PSULN+1
+268 QUIT
