Routine: PSUV12

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUV12   9264     printed  Mar 13, 2025@21:33:16                                                                                                                                                                                                      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

PSUV12.m