- 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
