Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASURD70I

ASURD70I.m

Go to the documentation of this file.
  1. ASURD70I ; IHS/ITSC/LMH -RPT 70I - ;
  1. ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. ;This routine formats and prints report 70I, Replenishment Post Posted
  1. ;Issues Invoice/Shipping list.
  1. I '$D(IO) D HOME^%ZIS
  1. I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
  1. I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1. S ASUK("PTRSEL")=$G(ASUK("PTRSEL")) I ASUK("PTRSEL")]"" G PSER
  1. S ZTRTN="PSER^ASURD70I",ZTDESC="SAMS RPT 70I" D O^ASUUZIS
  1. I POP S IOP=$I D ^%ZIS Q
  1. I ASUK(ASUK("PTR"),"Q") Q
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1. D U^ASUUZIS D DATE^ASUUDATE S ASUX("RPT")="R7I",ASUT="ISS" D P7
  1. S (ASUT(ASUT,"DTR"),ASUT(ASUT,"CAN"),ASUL(19,"USR"),ASUT(ASUT,"REQ#"),ASUT(ASUT,"SSA"))=""
  1. S ASUX("AR")=$O(^XTMP("ASUR","R7I",0))
  1. I ASUX("AR")="" D G K
  1. .W @IOF,!!,"NO DATA FOR REPORT 70I"
  1. E D READX^ASURD70P
  1. K ASUU,ASUX,ASUTR,ASUC,ASUV,ASULR,ASUF,DIC,DA,X,Y D PAZ^ASUURHDR Q:($D(DUOUT))
  1. I ASUK("PTRSEL")]"" W @IOF Q
  1. Q
  1. S ASUX("STA")=""
  1. F S ASUX("STA")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"))) Q:ASUX("STA")="" D
  1. .I ASUX("STA")'=ASUV("STA") D
  1. ..I ASUV("STA")="" S ASUV("STA")=ASUX("STA") D STA^ASULARST(ASUX("STA")) S ASUV("SST")=0
  1. .S ASUX("SST")="" F S ASUX("SST")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"))) Q:ASUX("SST")="" Q:$D(DUOUT) D
  1. ..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"))
  1. ..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
  1. ...I ASUV("VOU")="" S ASUF("HDR")=1,ASUC("PG")=0,ASUV("VOU")=ASUX("VOU")
  1. ...I ASUV("VOU")'=ASUX("VOU") S ASUF("HDR")=1,ASUC("PG")=0,ASUV("VOU")=ASUX("VOU")
  1. ...D INVOICE^ASURD70P
  1. K ;
  1. P7 ;EP ;SERIES INIT
  1. S ASUC("LN")=IOSL+1
  1. I ASUX("RPT")="ASUR71" D
  1. .S (ASUC("PG"),ASUF("1ST"),ASUF("BK"),ASUF("HDR"))=1,ASUF("END")=0
  1. E D
  1. .S (ASUF("1ST"),ASUF("BK"),ASUF("END"),ASUF("HDR"))=0
  1. S (ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUX("SEQ"))=""
  1. S (ASUV("VOU"),ASUV("STA"),ASUV("SST"),ASUV("SLC"),ASULR("SLC"))=""
  1. F ASUC("TR")=0:1:2 S ASUV("RMK",ASUC("TR"))=""
  1. S ASUS("QTYAJ")=1 S ASUA("DFN")=0
  1. Q