ASURD70P.m

ASURD70P ; IHS/ITSC/LMH -RPT 70 ; 

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;This routine formats and prints report 70, Replenishment Pre Posted

 ;Issues Invoice/Shipping list.

 D:'$D(IO) HOME^%ZIS I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q

 I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST

 S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER

 S ZTRTN="PSER^ASURD70P",ZTDESC="SAMS RPT 70" D O^ASUUZIS

 I POP S IOP=$I D ^%ZIS Q

 I ASUK(ASUK("PTR"),"Q") Q

PSER ;EP;FOR TASKMAN QUEUE OF PRINT

 D U^ASUUZIS,DATE^ASUUDATE S ASUX("RPT")="R70",ASUT="ISS",ASUP0="INVOICE^ASURD70P",ASUHD="HEADER^ASURD70P" D P7^ASURD70I

 S Y=$P(^XTMP("ASUR",ASUX("RPT"),0),U,2) X ^DD("DD") S ASUX("DT")=Y

 S X=$O(^XTMP("ASUR",ASUX("RPT"),0)) I X']"" D

 .W @IOF,!!,"NO DATA FOR REPORT 70"

 E  D READX

 K ASUU,ASUT,ASUC,ASUCL,ASUV,ASUF,ASUA,DIC,DA,X,Y F X=3:1:22 K ASUL(X)

 D PAZ^ASUURHDR Q:$D(DUOUT)  W @IOF

 D ^ASURD70I I $G(ASUK("PTRSEL"))]"" W @IOF Q

 D C^ASUUZIS

 Q

READX ;EP ;READ TMP GLOBAL

 S ASUX("STA")=0 F  S ASUX("STA")=$O(^XTMP("ASUR",ASUX("RPT"),$G(ASUX("STA")))) Q:ASUX("STA")=""  D

 .I ASUX("STA")'=$G(ASUV("STA")) D

 ..I $G(ASUV("STA"))="" S ASUV("STA")=ASUX("STA") D STA^ASULARST(ASUX("STA"))

 .S ASUX("SST")=0

 .F  S ASUX("SST")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"))) Q:ASUX("SST")=""  Q:$D(DUOUT)  D

 ..S ASUF("HDR")=0,ASUX("VOU")=""

 ..I $G(ASUV("SST"))'=ASUX("SST") D

 ...I $G(ASUV("SST"))="" S ASUV("SST")=ASUX("SST") D SST^ASULDIRR(ASUV("SST"))

 ..S ASUX("VOU")=""

 ..F  S ASUX("VOU")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"))) Q:ASUX("VOU")=""  Q:$D(DUOUT)  D

 ...I $G(ASUV("VOU"))'=ASUX("VOU") S ASUF("HDR")=1,ASUC("PG")=0,ASUV("VOU")=ASUX("VOU")

 ...S ASUX("SLC")="" F  S ASUX("SLC")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"))) Q:ASUX("SLC")=""  D

 ....D:$G(ASUL(10,"SLC"))'=ASUX("SLC") SLC^ASULDIRR(ASUX("SLC")) S ASUV("SLC")=ASUX("SLC")

 ....S ASUX("IDX")=0

 ....F  S ASUX("IDX")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"))) Q:ASUX("IDX")=""  D

 .....S ASUHDA="",ASUV("IDX")=ASUX("IDX")

 .....F  S ASUHDA=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUHDA)) Q:ASUHDA=""  D

 ......D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""

 ......D @ASUP0

 ....S ASUX("IDX")=ASUV("IDX")

 ...D SLCBK K ASUC(1) S ASUF("BK")=1

 ...D LSTSLC S ASUX("SLC")=ASUV("SLC"),ASUF("BK")=2

 ..D SSTBK

 Q

SSTBK ;Sub Station Break

 I $G(ASUA("#"))>0 D

 .S ASUA("#")="",ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1,ASUF("BK")=3

 .F  S ASUA("#")=$O(ASUAN($G(ASUA("#")))) Q:ASUA("#")=""  D

 ..S ASUV("#")=$G(ASUA("#")),ASUADA=$P(ASUAN(ASUA("#")),U) D READ^ASU0TRRD(.ASUADA,"H")

 ..S ASUV("RMK",0)=$P(ASUAN(ASUA("#")),U,2)

 ..S ASUV("RMK",1)=$P(ASUAN(ASUA("#")),U,3)

 ..S ASUC(0,"QTYREQ")=ASUT(ASUT,"QTY","REQ")

 ..S ASUC(0,"QTYISS")=$S(ASUV("RMK",0)="B/O O/F":0,1:ASUT(ASUT,"QTY","ISS"))

 ..S ASUC(0,"UCS")=$S(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FN(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))

 ..S ASUC(0,"VAL")=ASUT(ASUT,"VAL"),ASUC(0,"DIF")=ASUC(0,"QTYISS")-ASUC(0,"QTYREQ")

 ..S ASUX("IDX")=ASUT(ASUT,"PT","IDX") D IDXBK Q:$D(DUOUT)

 ..K ASUAN(ASUA("#")),ASUA("#")

 .W !!,"TOTAL LINE ITEMS : ",$J($FN(ASUV("#"),","),7),! S ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+3,ASUV("IDX")=ASUX("IDX")

 .K ASUC(0)

 .K ASUA,ASUQT(0) S ASUA("#")=0

 Q

INVOICE ;EP;INVOICE

 I ASUF("BK")=1 D HEADER S ASUF("BK")=0

 S ASUT(ASUT,"QTY","ISS")=$G(ASUT(ASUT,"QTY","ISS")) S:ASUT(ASUT,"QTY","ISS")']"" ASUT(ASUT,"QTY","ISS")=$G(ASUT(ASUT,"QTY"))

 S ASUC(0,"UCS")=$S(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FN(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))

 I ASUT(ASUT,"QTY","ISS")>0 D

 .S ASUC(0,"VAL")=$G(ASUC(0,"VAL"))+ASUT(ASUT,"VAL")

 .S ASUC(0,"QTYREQ")=$G(ASUC(0,"QTYREQ"))+ASUT(ASUT,"QTY","REQ")

 .S ASUC(0,"QTYISS")=$G(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")

 I ($G(ASUT(ASUT,"QTY","REQ"))>0)&(ASUT(ASUT,"QTY","ISS")=0) S ASUC(0,"QTYREQ")=$G(ASUC(0,"QTYREQ"))+$G(ASUT(ASUT,"QTY","REQ"))

 I ASUT(ASUT,"QTY","ISS")'>0 S ASUT(ASUT,"QTY","ISS")=0,ASUV("RMK",0)="STK OUT"

 I ASUT(ASUT,"QTY","ISS")=0 S ASUC(0,"OUT")=$G(ASUC(0,"OUT"))+1

 S ASUC(0,"ITEM")=$G(ASUC(0,"ITEM"))+1

 I ASUT(ASUT,"FPN")="B" D

 .S ASUT(ASUT,"FPN")="N",ASUC(0,"QTYISS")=0,ASUC(0,"PART")=$G(ASUC(0,"PART"))+1

 .S ASUV("RMK",1)="B/O O/F",ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1

 .S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))

 I ASUT(ASUT,"FPN")="P" D

 .I ASUX("RPT")="R7I" S ASUV("RMK",1)="PAR ISS"

 .E  S ASUV("RMK",1)="PAR B/0"

 .S ASUC(0,"PART")=$G(ASUC(0,"PART"))+1,ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1

 .S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))

 I (ASUT(ASUT,"QTY","REQ")>0)&(ASUT(ASUT,"QTY","ISS")=0) D

 .S ASUV("RMK",1)="TOT B/O",ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1

 .S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))

 I ASUT(ASUT,"QTY","ADJ")="A" D

 .S ASUS("QTYAJ")=1 I $G(ASUA("#"))>0 D

 ..I $P(ASUAN(ASUA("#")),U)=ASUHDA Q

 ..S ASUA("#")=$G(ASUA("#"))+1

 .S ASUV("RMK",2)="QTY ADJ" S:$G(ASUA("#"))']"" ASUA("#")=1

 .S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))

 S ASUF("BK")=0

 D IDXBK Q:$D(DUOUT)

 N X S X="" F  S X=$O(ASUC(0,X)) Q:X']""  S ASUC(1,X)=$G(ASUC(1,X))+ASUC(0,X)

 K ASUC(0)

 Q

IDXBK ;EP;INDEX

 I ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") D @ASUHD Q:$D(DUOUT)

 I ASUX("RPT")'="R71" D

 .I $G(ASUV("RMK",1))=""&($G(ASUV("RMK",0))="") S ASUV("RMK",0)=$G(ASUV("RMK",2)) K ASUV("RMK",2)

 .I $G(ASUV("RMK",0))=""&($G(ASUV("RMK",1))]"") S ASUV("RMK",0)=$G(ASUV("RMK",1)) K ASUV("RMK",1)

 .I $G(ASUV("RMK",0))]""&($G(ASUV("RMK",1))]"") S ASUV("RMK",2)=$G(ASUV("RMK",1))

 E  S ASUV("RMK",0)=$G(ASUT(ASUT,"RMK"))

 W !!?1,$E($G(ASUX("IDX")),3,7),".",$E($G(ASUX("IDX")),8,8),?30,$G(ASUMX("AR U/I"))

 W ?34,$J($FN($G(ASUC(0,"QTYREQ")),",",0),6),?44,$J($FN($G(ASUC(0,"QTYISS")),",",0),6),"*",?52,$J($FN($G(ASUC(0,"UCS")),",",2),8),?62,$J($FN($G(ASUC(0,"VAL")),",",2),10),?73,$G(ASUV("RMK",0))

 W !?5,$S($G(ASUMX("DESC"))]"":ASUMX("DESC"),1:$G(ASUMX("DELDS"))),?73,$S($G(ASUC(0,"DIF"))]"":$J($G(ASUC(0,"DIF")),7),1:$G(ASUV("RMK",2)))

 W !,"________________________________________________________________________________"

 S ASUC("LN")=ASUC("LN")+6 K ASUV("RMK")

 Q

SLCBK ;EP; STORAGE LOCATION CODE BRK

 S ASUC("LN")=ASUC("LN")+2

 I ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") D HEADER Q:$D(DUOUT)

 W !!?2,"TOTAL LINE ITEMS: ",?20,$J($FN($G(ASUC(1,"ITEM")),","),5),?26,"NO. OUTS: " W ?36,$J($FN($G(ASUC(1,"OUT")),","),5),?42,"NO. PARTIALS: ",?56,$J($FN($G(ASUC(1,"PART")),","),5)

 W ?62,$J($FN($G(ASUC(1,"VAL")),",",2),10)

 W !!?3,"ISSUED BY:",?42,"CHECKED BY:",!?5,"DATE:",?45,"DATE:",!?5,"TIME STARTED:",?45,"TIME STARTED:",!?5,"TIME FINISHED:",?45,"TIME FINISHED:",!

 S ASUC("LN")=ASUC("LN")+6

 N X S X="" F  S X=$O(ASUC(1,X)) Q:X']""  S ASUCL(ASUV("SLC"),X)=$G(ASUCL(ASUV("SLC"),X))+ASUC(1,X)

 Q

LSTSLC ;EP ;

 D @ASUHD S ASULR("SLC")=9

 S ASULR("SLC")=0 F  S ASULR("SLC")=$O(ASUCL(ASULR("SLC"))) Q:ASULR("SLC")']""  D

 .Q:ASULR("SLC")?1N

 .D SLC^ASULDIRR(ASULR("SLC")) W !!?2,$J(ASUL(10,"SLC","NM"),13)

 .W ?17,$J($FN($G(ASUCL(ASULR("SLC"),"ITEM")),",",0),6)

 .W ?24,$J($FN($G(ASUCL(ASULR("SLC"),"OUT")),",",0),6)

 .W ?35,$J($FN($G(ASUCL(ASULR("SLC"),"PART")),",",0),6)

 .W ?42,$J($FN($G(ASUCL(ASULR("SLC"),"VAL")),",",2),10)

 .N X S X="" F  S X=$O(ASUCL(ASULR("SLC"),X)) Q:X']""  S ASUC(2,X)=$G(ASUC(2,X))+ASUCL(ASULR("SLC"),X)

 .K ASUCL(ASULR("SLC"))

 S X2=0,X3=5

 W !!?2,"T O T A L",?17,$J($FN($G(ASUC(2,"ITEM")),",",0),6),?24,$J($FN($G(ASUC(2,"OUT")),",",0),6)

 W ?35,$J($FN($G(ASUC(2,"PART")),",",0),6),?42,$J($FN($G(ASUC(2,"VAL")),",",2),10),!

 S ASUF("BK")=0,ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1,ASUV("VOU")=ASUX("VOU") K ASUC(2),ASUCL(0)

 Q

HEADER ;EP ;HDR

 S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LN")=0 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT)  W @IOF

 S ASUV("HEAD")=$S(ASUX("RPT")="R70":"70  ISSUE/SHIPPING/INVOICE DOCUMENT",1:"70I POST-POSTED ISSUE/INVOICE DOCUMENT")

 W !?1,"REPORT #",ASUV("HEAD") W ?55,ASUX("DT"),?73,"PAGE ",ASUC("PG")

 W !?3,"AREA ",ASUL(1,"AR","AP") W ?15,ASUL(1,"AR","NM")

 W ?40,"STATION ",ASUL(2,"STA","CD"),?51,ASUL(2,"STA","NM")

 W !?1,"REQUISITIONER: LOC  ",ASUL(18,"SST")," -",?26,ASUL(18,"SST","NM")

 W ?48,"DATE OF REQUEST: " S Y=ASUT(ASUT,"DTR") X ^DD("DD") W ?66,Y

 W !!?1,"CAN ",?6,ASUT(ASUT,"CAN"),?15,"USER ",?19,ASUL(19,"USR"),?24,"-",?26,ASUL(19,"USR","NM")

 W ?49,"REQUEST NO. ",?61,ASUT(ASUT,"RQN"),!!?1,"SSA ",?6,ASUT(ASUT,"SSA"),?10,"CONTRACT/GRANT NO: ",?30,ASUT(ASUT,"CTG")

 W ?48,"VOUCHER NO: ",?60,ASUV("VOU")

 I ASUF("BK")=2!(ASUF("END")=1) D

 .S ASUC("LN")=ASUC("LN")+7 W !!?27,"VOUCHER NUMBER CONTROL SHEET",!!?18,"NO LI     LI     NO LI       ISSUE  ISSUE DOC"

 .W !?1,"STORAGE LOC      ITEMS   OUTS  PARTIALS       VALUE  ASSIGNED TO   DATE" S ASUC("LN")=ASUC("LN")+5

 E  D

 .I ASUF("BK")=3 W !!?23,"LISTING OF ORDER QUANTITY CHANGES" S ASUC("LN")=ASUC("LN")+2

 .E  W !!?1,"STORAGE LOCATION:",?20,$G(ASUL(10,"SLC","NM"))

 .W !!!?3,"INDEX",?36,"QUANT",?46,"QUANT",?56,"UNIT",?66,"TOTAL"

 .W !?2,"NUMBER  DESCRIPTION",?30,"UI",?36,$S(ASUX("RPT")="R71":"B/O",1:"REQ'D"),?45,"ISSUED",?56,"COST",?67,"COST",?73,"REMARKS"

 .W !,"________________________________________________________________________________"

 .S ASUC("LN")=ASUC("LN")+14,ASUF("HDR")=0

 Q

ASURD70P  ; IHS/ITSC/LMH -RPT 70 ; 

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;This routine formats and prints report 70, Replenishment Pre Posted

 +3       ;Issues Invoice/Shipping list.

 +4        IF '$DATA(IO)

               DO HOME^%ZIS

           IF '$DATA(DUZ(2))

               WRITE !,"Report must be run from Kernel option"

               QUIT 

 +5        IF '$DATA(ASUL(1,"AR","AP"))

               DO SETAREA^ASULARST

 +6        SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))

           IF ASUK("PTRSEL")]""

               GOTO PSER

 +7        SET ZTRTN="PSER^ASURD70P"

           SET ZTDESC="SAMS RPT 70"

           DO O^ASUUZIS

 +8        IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

 +9        IF ASUK(ASUK("PTR"),"Q")

               QUIT 

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        DO U^ASUUZIS

           DO DATE^ASUUDATE

           SET ASUX("RPT")="R70"

           SET ASUT="ISS"

           SET ASUP0="INVOICE^ASURD70P"

           SET ASUHD="HEADER^ASURD70P"

           DO P7^ASURD70I

 +2        SET Y=$PIECE(^XTMP("ASUR",ASUX("RPT"),0),U,2)

           XECUTE ^DD("DD")

           SET ASUX("DT")=Y

 +3        SET X=$ORDER(^XTMP("ASUR",ASUX("RPT"),0))

           IF X']""

               Begin DoDot:1

 +4                WRITE @IOF,!!,"NO DATA FOR REPORT 70"

               End DoDot:1

 +5       IF '$TEST

               DO READX

 +6        KILL ASUU,ASUT,ASUC,ASUCL,ASUV,ASUF,ASUA,DIC,DA,X,Y

           FOR X=3:1:22

               KILL ASUL(X)

 +7        DO PAZ^ASUURHDR

           IF $DATA(DUOUT)

               QUIT 

           WRITE @IOF

 +8        DO ^ASURD70I

           IF $GET(ASUK("PTRSEL"))]""

               WRITE @IOF

               QUIT 

 +9        DO C^ASUUZIS

 +10       QUIT 

READX     ;EP ;READ TMP GLOBAL

 +1        SET ASUX("STA")=0

           FOR 

               SET ASUX("STA")=$ORDER(^XTMP("ASUR",ASUX("RPT"),$GET(ASUX("STA"))))

               IF ASUX("STA")=""

                   QUIT 

               Begin DoDot:1

 +2                IF ASUX("STA")'=$GET(ASUV("STA"))

                       Begin DoDot:2

 +3                        IF $GET(ASUV("STA"))=""

                               SET ASUV("STA")=ASUX("STA")

                               DO STA^ASULARST(ASUX("STA"))

                       End DoDot:2

 +4                SET ASUX("SST")=0

 +5                FOR 

                       SET ASUX("SST")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST")))

                       IF ASUX("SST")=""

                           QUIT 

                       IF $DATA(DUOUT)

                           QUIT 

                       Begin DoDot:2

 +6                        SET ASUF("HDR")=0

                           SET ASUX("VOU")=""

 +7                        IF $GET(ASUV("SST"))'=ASUX("SST")

                               Begin DoDot:3

 +8                                IF $GET(ASUV("SST"))=""

                                       SET ASUV("SST")=ASUX("SST")

                                       DO SST^ASULDIRR(ASUV("SST"))

                               End DoDot:3

 +9                        SET ASUX("VOU")=""

 +10                       FOR 

                               SET ASUX("VOU")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU")))

                               IF ASUX("VOU")=""

                                   QUIT 

                               IF $DATA(DUOUT)

                                   QUIT 

                               Begin DoDot:3

 +11                               IF $GET(ASUV("VOU"))'=ASUX("VOU")

                                       SET ASUF("HDR")=1

                                       SET ASUC("PG")=0

                                       SET ASUV("VOU")=ASUX("VOU")

 +12                               SET ASUX("SLC")=""

                                   FOR 

                                       SET ASUX("SLC")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC")))

                                       IF ASUX("SLC")=""

                                           QUIT 

                                       Begin DoDot:4

 +13                                       IF $GET(ASUL(10,"SLC"))'=ASUX("SLC")

                                               DO SLC^ASULDIRR(ASUX("SLC"))

                                           SET ASUV("SLC")=ASUX("SLC")

 +14                                       SET ASUX("IDX")=0

 +15                                       FOR 

                                               SET ASUX("IDX")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX")))

                                               IF ASUX("IDX")=""

                                                   QUIT 

                                               Begin DoDot:5

 +16                                               SET ASUHDA=""

                                                   SET ASUV("IDX")=ASUX("IDX")

 +17                                               FOR 

                                                       SET ASUHDA=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUHDA))

                                                       IF ASUHDA=""

                                                           QUIT 

                                                       Begin DoDot:6

 +18                                                       DO READ^ASU0TRRD(.ASUHDA,"H")

                                                           IF $GET(ASUT)']""

                                                               QUIT 

 +19                                                       DO @ASUP0

                                                       End DoDot:6

                                               End DoDot:5

 +20                                       SET ASUX("IDX")=ASUV("IDX")

                                       End DoDot:4

 +21                               DO SLCBK

                                   KILL ASUC(1)

                                   SET ASUF("BK")=1

 +22                               DO LSTSLC

                                   SET ASUX("SLC")=ASUV("SLC")

                                   SET ASUF("BK")=2

                               End DoDot:3

 +23                       DO SSTBK

                       End DoDot:2

               End DoDot:1

 +24       QUIT 

SSTBK     ;Sub Station Break

 +1        IF $GET(ASUA("#"))>0

               Begin DoDot:1

 +2                SET ASUA("#")=""

                   SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1

                   SET ASUF("BK")=3

 +3                FOR 

                       SET ASUA("#")=$ORDER(ASUAN($GET(ASUA("#"))))

                       IF ASUA("#")=""

                           QUIT 

                       Begin DoDot:2

 +4                        SET ASUV("#")=$GET(ASUA("#"))

                           SET ASUADA=$PIECE(ASUAN(ASUA("#")),U)

                           DO READ^ASU0TRRD(.ASUADA,"H")

 +5                        SET ASUV("RMK",0)=$PIECE(ASUAN(ASUA("#")),U,2)

 +6                        SET ASUV("RMK",1)=$PIECE(ASUAN(ASUA("#")),U,3)

 +7                        SET ASUC(0,"QTYREQ")=ASUT(ASUT,"QTY","REQ")

 +8                        SET ASUC(0,"QTYISS")=$SELECT(ASUV("RMK",0)="B/O O/F":0,1:ASUT(ASUT,"QTY","ISS"))

 +9                        SET ASUC(0,"UCS")=$SELECT(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FNUMBER(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))

 +10                       SET ASUC(0,"VAL")=ASUT(ASUT,"VAL")

                           SET ASUC(0,"DIF")=ASUC(0,"QTYISS")-ASUC(0,"QTYREQ")

 +11                       SET ASUX("IDX")=ASUT(ASUT,"PT","IDX")

                           DO IDXBK

                           IF $DATA(DUOUT)

                               QUIT 

 +12                       KILL ASUAN(ASUA("#")),ASUA("#")

                       End DoDot:2

 +13               WRITE !!,"TOTAL LINE ITEMS : ",$JUSTIFY($FNUMBER(ASUV("#"),","),7),!

                   SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+3

                   SET ASUV("IDX")=ASUX("IDX")

 +14               KILL ASUC(0)

 +15               KILL ASUA,ASUQT(0)

                   SET ASUA("#")=0

               End DoDot:1

 +16       QUIT 

INVOICE   ;EP;INVOICE

 +1        IF ASUF("BK")=1

               DO HEADER

               SET ASUF("BK")=0

 +2        SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY","ISS"))

           IF ASUT(ASUT,"QTY","ISS")']""

               SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY"))

 +3        SET ASUC(0,"UCS")=$SELECT(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FNUMBER(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))

 +4        IF ASUT(ASUT,"QTY","ISS")>0

               Begin DoDot:1

 +5                SET ASUC(0,"VAL")=$GET(ASUC(0,"VAL"))+ASUT(ASUT,"VAL")

 +6                SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+ASUT(ASUT,"QTY","REQ")

 +7                SET ASUC(0,"QTYISS")=$GET(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")

               End DoDot:1

 +8        IF ($GET(ASUT(ASUT,"QTY","REQ"))>0)&(ASUT(ASUT,"QTY","ISS")=0)

               SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+$GET(ASUT(ASUT,"QTY","REQ"))

 +9        IF ASUT(ASUT,"QTY","ISS")'>0

               SET ASUT(ASUT,"QTY","ISS")=0

               SET ASUV("RMK",0)="STK OUT"

 +10       IF ASUT(ASUT,"QTY","ISS")=0

               SET ASUC(0,"OUT")=$GET(ASUC(0,"OUT"))+1

 +11       SET ASUC(0,"ITEM")=$GET(ASUC(0,"ITEM"))+1

 +12       IF ASUT(ASUT,"FPN")="B"

               Begin DoDot:1

 +13               SET ASUT(ASUT,"FPN")="N"

                   SET ASUC(0,"QTYISS")=0

                   SET ASUC(0,"PART")=$GET(ASUC(0,"PART"))+1

 +14               SET ASUV("RMK",1)="B/O O/F"

                   SET ASUS("QTYAJ")=0

                   SET ASUA("#")=$GET(ASUA("#"))+1

 +15               SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))

               End DoDot:1

 +16       IF ASUT(ASUT,"FPN")="P"

               Begin DoDot:1

 +17               IF ASUX("RPT")="R7I"

                       SET ASUV("RMK",1)="PAR ISS"

 +18              IF '$TEST

                       SET ASUV("RMK",1)="PAR B/0"

 +19               SET ASUC(0,"PART")=$GET(ASUC(0,"PART"))+1

                   SET ASUS("QTYAJ")=0

                   SET ASUA("#")=$GET(ASUA("#"))+1

 +20               SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))

               End DoDot:1

 +21       IF (ASUT(ASUT,"QTY","REQ")>0)&(ASUT(ASUT,"QTY","ISS")=0)

               Begin DoDot:1

 +22               SET ASUV("RMK",1)="TOT B/O"

                   SET ASUS("QTYAJ")=0

                   SET ASUA("#")=$GET(ASUA("#"))+1

 +23               SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))

               End DoDot:1

 +24       IF ASUT(ASUT,"QTY","ADJ")="A"

               Begin DoDot:1

 +25               SET ASUS("QTYAJ")=1

                   IF $GET(ASUA("#"))>0

                       Begin DoDot:2

 +26                       IF $PIECE(ASUAN(ASUA("#")),U)=ASUHDA

                               QUIT 

 +27                       SET ASUA("#")=$GET(ASUA("#"))+1

                       End DoDot:2

 +28               SET ASUV("RMK",2)="QTY ADJ"

                   IF $GET(ASUA("#"))']""

                       SET ASUA("#")=1

 +29               SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))

               End DoDot:1

 +30       SET ASUF("BK")=0

 +31       DO IDXBK

           IF $DATA(DUOUT)

               QUIT 

 +32       NEW X

           SET X=""

           FOR 

               SET X=$ORDER(ASUC(0,X))

               IF X']""

                   QUIT 

               SET ASUC(1,X)=$GET(ASUC(1,X))+ASUC(0,X)

 +33       KILL ASUC(0)

 +34       QUIT 

IDXBK     ;EP;INDEX

 +1        IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")

               DO @ASUHD

               IF $DATA(DUOUT)

                   QUIT 

 +2        IF ASUX("RPT")'="R71"

               Begin DoDot:1

 +3                IF $GET(ASUV("RMK",1))=""&($GET(ASUV("RMK",0))="")

                       SET ASUV("RMK",0)=$GET(ASUV("RMK",2))

                       KILL ASUV("RMK",2)

 +4                IF $GET(ASUV("RMK",0))=""&($GET(ASUV("RMK",1))]"")

                       SET ASUV("RMK",0)=$GET(ASUV("RMK",1))

                       KILL ASUV("RMK",1)

 +5                IF $GET(ASUV("RMK",0))]""&($GET(ASUV("RMK",1))]"")

                       SET ASUV("RMK",2)=$GET(ASUV("RMK",1))

               End DoDot:1

 +6       IF '$TEST

               SET ASUV("RMK",0)=$GET(ASUT(ASUT,"RMK"))

 +7        WRITE !!?1,$EXTRACT($GET(ASUX("IDX")),3,7),".",$EXTRACT($GET(ASUX("IDX")),8,8),?30,$GET(ASUMX("AR U/I"))

 +8        WRITE ?34,$JUSTIFY($FNUMBER($GET(ASUC(0,"QTYREQ")),",",0),6),?44,$JUSTIFY($FNUMBER($GET(ASUC(0,"QTYISS")),",",0),6),"*",?52,$JUSTIFY($FNUMBER($GET(ASUC(0,"UCS")),",",2),8),?62,$JUSTIFY($FNUMBER($GET(ASUC(0,"VAL")),",",2),10),?73,$GET(ASUV("RMK"

,0))

 +9        WRITE !?5,$SELECT($GET(ASUMX("DESC"))]"":ASUMX("DESC"),1:$GET(ASUMX("DELDS"))),?73,$SELECT($GET(ASUC(0,"DIF"))]"":$JUSTIFY($GET(ASUC(0,"DIF")),7),1:$GET(ASUV("RMK",2)))

 +10       WRITE !,"________________________________________________________________________________"

 +11       SET ASUC("LN")=ASUC("LN")+6

           KILL ASUV("RMK")

 +12       QUIT 

SLCBK     ;EP; STORAGE LOCATION CODE BRK

 +1        SET ASUC("LN")=ASUC("LN")+2

 +2        IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")

               DO HEADER

               IF $DATA(DUOUT)

                   QUIT 

 +3        WRITE !!?2,"TOTAL LINE ITEMS: ",?20,$JUSTIFY($FNUMBER($GET(ASUC(1,"ITEM")),","),5),?26,"NO. OUTS: "

           WRITE ?36,$JUSTIFY($FNUMBER($GET(ASUC(1,"OUT")),","),5),?42,"NO. PARTIALS: ",?56,$JUSTIFY($FNUMBER($GET(ASUC(1,"PART")),","),5)