ASURD70I.m

ASURD70I ; IHS/ITSC/LMH -RPT 70I - ; 

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

 ;This routine formats and prints report 70I, Replenishment Post Posted

 ;Issues Invoice/Shipping list.

 I '$D(IO) D 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^ASURD70I",ZTDESC="SAMS RPT 70I" 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 D DATE^ASUUDATE S ASUX("RPT")="R7I",ASUT="ISS" D P7

 S (ASUT(ASUT,"DTR"),ASUT(ASUT,"CAN"),ASUL(19,"USR"),ASUT(ASUT,"REQ#"),ASUT(ASUT,"SSA"))=""

 S ASUX("AR")=$O(^XTMP("ASUR","R7I",0))

 I ASUX("AR")="" D  G K

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

 E  D READX^ASURD70P

 K ASUU,ASUX,ASUTR,ASUC,ASUV,ASULR,ASUF,DIC,DA,X,Y D PAZ^ASUURHDR Q:($D(DUOUT))

 I ASUK("PTRSEL")]"" W @IOF Q

 Q

 S ASUX("STA")=""

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

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

 ..I ASUV("STA")="" S ASUV("STA")=ASUX("STA") D STA^ASULARST(ASUX("STA")) S ASUV("SST")=0

 .S ASUX("SST")="" 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")="" S:ASUV("SST")="" ASUV("SST")=ASUX("SST") S:ASUV("SST")'=ASUX("SST") 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 ASUV("VOU")="" S ASUF("HDR")=1,ASUC("PG")=0,ASUV("VOU")=ASUX("VOU")

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

 ...D INVOICE^ASURD70P

K ;

P7 ;EP ;SERIES INIT

 S ASUC("LN")=IOSL+1

 I ASUX("RPT")="ASUR71" D

 .S (ASUC("PG"),ASUF("1ST"),ASUF("BK"),ASUF("HDR"))=1,ASUF("END")=0

 E  D

 .S (ASUF("1ST"),ASUF("BK"),ASUF("END"),ASUF("HDR"))=0

 S (ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUX("SEQ"))=""

 S (ASUV("VOU"),ASUV("STA"),ASUV("SST"),ASUV("SLC"),ASULR("SLC"))=""

 F ASUC("TR")=0:1:2 S ASUV("RMK",ASUC("TR"))=""

 S ASUS("QTYAJ")=1 S ASUA("DFN")=0

 Q

ASURD70I  ; IHS/ITSC/LMH -RPT 70I - ; 

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

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

 +3       ;Issues Invoice/Shipping list.

 +4        IF '$DATA(IO)

               DO HOME^%ZIS

 +5        IF '$DATA(DUZ(2))

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

               QUIT 

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

               DO SETAREA^ASULARST

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

           IF ASUK("PTRSEL")]""

               GOTO PSER

 +8        SET ZTRTN="PSER^ASURD70I"

           SET ZTDESC="SAMS RPT 70I"

           DO O^ASUUZIS

 +9        IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

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

               QUIT 

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        DO U^ASUUZIS

           DO DATE^ASUUDATE

           SET ASUX("RPT")="R7I"

           SET ASUT="ISS"

           DO P7

 +2        SET (ASUT(ASUT,"DTR"),ASUT(ASUT,"CAN"),ASUL(19,"USR"),ASUT(ASUT,"REQ#"),ASUT(ASUT,"SSA"))=""

 +3        SET ASUX("AR")=$ORDER(^XTMP("ASUR","R7I",0))

 +4        IF ASUX("AR")=""

               Begin DoDot:1

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

               End DoDot:1

               GOTO K

 +6       IF '$TEST

               DO READX^ASURD70P

 +7        KILL ASUU,ASUX,ASUTR,ASUC,ASUV,ASULR,ASUF,DIC,DA,X,Y

           DO PAZ^ASUURHDR

           IF ($DATA(DUOUT))

               QUIT 

 +8        IF ASUK("PTRSEL")]""

               WRITE @IOF

               QUIT 

 +9        QUIT 

 +10       SET ASUX("STA")=""

 +11       FOR 

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

               IF ASUX("STA")=""

                   QUIT 

               Begin DoDot:1

 +12               IF ASUX("STA")'=ASUV("STA")

                       Begin DoDot:2

 +13                       IF ASUV("STA")=""

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

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

                               SET ASUV("SST")=0

                       End DoDot:2

 +14               SET ASUX("SST")=""

                   FOR 

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

                       IF ASUX("SST")=""

                           QUIT 

                       IF $DATA(DUOUT)

                           QUIT 

                       Begin DoDot:2

 +15                       SET ASUF("HDR")=0

                           SET ASUX("VOU")=""

                           IF ASUV("SST")=""

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

                           IF ASUV("SST")'=ASUX("SST")

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

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

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

                           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

 +17                               IF ASUV("VOU")=""

                                       SET ASUF("HDR")=1

                                       SET ASUC("PG")=0

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

 +18                               IF ASUV("VOU")'=ASUX("VOU")

                                       SET ASUF("HDR")=1

                                       SET ASUC("PG")=0

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

 +19                               DO INVOICE^ASURD70P

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

K         ;

P7        ;EP ;SERIES INIT

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

 +2        IF ASUX("RPT")="ASUR71"

               Begin DoDot:1

 +3                SET (ASUC("PG"),ASUF("1ST"),ASUF("BK"),ASUF("HDR"))=1

                   SET ASUF("END")=0

               End DoDot:1

 +4       IF '$TEST

               Begin DoDot:1

 +5                SET (ASUF("1ST"),ASUF("BK"),ASUF("END"),ASUF("HDR"))=0

               End DoDot:1

 +6        SET (ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUX("SEQ"))=""

 +7        SET (ASUV("VOU"),ASUV("STA"),ASUV("SST"),ASUV("SLC"),ASULR("SLC"))=""

 +8        FOR ASUC("TR")=0:1:2

               SET ASUV("RMK",ASUC("TR"))=""

 +9        SET ASUS("QTYAJ")=1

           SET ASUA("DFN")=0

 +10       QUIT