- ASURD71P ; IHS/ITSC/LMH -RPT 70 ISS/SHIP/INV DOC ;
- ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- ;This routine formats and prints report 71, Backorder Release
- ;Invoice/Shipping list.
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 71
- 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^ASURD71P",ZTDESC="SAMS RPT 71" 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 S ASUC("LN")=IOSL+1,ASUX("RPT")="R71",ASUT="ISB",ASUP0="INVOICE^ASURD71P",ASUHD="HEADER^ASURD71P" D P7^ASURD70I
- S ASUX("DT")=$P($G(^XTMP("ASUR","R71",0)),U,2)
- I ASUX("DT")']"" D
- .D HEADER Q:$D(DUOUT) W !,"NO DATA FOR REPORT 71"
- E D
- .D READX^ASURD70P
- K ASUC,ASUF,ASUX,ASUV,ASUP0,ASUHD,ASUTX,DIC,DA,X,Y F X=3:1:22 K ASUL(X)
- D PAZ^ASUURHDR I ASUK("PTRSEL")]"" W @IOF Q
- D C^ASUUZIS
- Q
- INVOICE ;EP ;INVOICE
- 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"),ASUC(0,"QTYISS")=$G(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")
- I (ASUT(ASUT,"B/O")>0)&(ASUT(ASUT,"QTY","ISS")=0) S ASUC(0,"QTYREQ")=ASUC
- I (ASUT(ASUT,"B/O")>0)&(ASUT(ASUT,"QTY","ISS")=0) S ASUC(0,"QTYREQ")=$G(ASUC(0,"QTYREQ"))+$G(ASUT(ASUT,"B/O"))
- I ASUT(ASUT,"QTY","ISS")'>0 S ASUT(ASUT,"QTY","ISS")=0
- I ASUT(ASUT,"QTY","ISS")=0 S ASUC(0,"OUT")=$G(ASUC(0,"OUT"))+1
- I ASUT(ASUT,"FPN")="P" S ASUC(0,"PART")=$G(ASUC(0,"PART"))+1
- S ASUC(0,"ITEM")=$G(ASUC(0,"ITEM"))+1
- D IDXBK^ASURD70P
- 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
- U IO S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=0 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
- W !?1,"REPORT #71 BACK ORDER ISSUE/SHIPPING/INVOICE DOCUMENT"
- S Y=ASUX("DT") X ^DD("DD") W ?60,Y,?73,"PAGE ",ASUC("PG")
- W !?3,"AREA ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
- Q:ASUX("STA")']""
- W ?40,"STATION ",ASUL(2,"STA","CD"),?51,ASUL(2,"STA","NM")
- W !?1,"REQUISITIONER: LOC ",$G(ASUL(18,"SST"))," -",?26,$G(ASUL(18,"SST","NM"))
- W ?48,"DATE OF REQUEST: " S Y=ASUT(ASUT,"DTR") X ^DD("DD") W ?66,Y
- W !!?1,"CAN ",?6,$G(ASUT(ASUT,"CAN")),?15,"USER ",?19,$G(ASUL(19,"USR")),?24,"-",?26,$G(ASUL(19,"USR","NM")),?49,"REQUEST NO. ",?61,$G(ASUT(ASUT,"RQN"))
- W !!?1,"SSA ",?6,$G(ASUT(ASUT,"SSA")),?10,"CONTRACT/GRANT NO: ",?30,$G(ASUT(ASUT,"CTG"))
- W ?48,"VOUCHER NO: ",?60,ASUV("VOU")
- I ASUF("BK")=1!(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")=2 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,"B/O",?45,"ISSUED",?56,"COST",?67,"COST",?73,"REMARKS"
- .W !,"________________________________________________________________________________"
- .S ASUC("LN")=ASUC("LN")+14,ASUF("HDR")=0
- Q
- CMPT ;EP ;SORT,SLC,LOC
- K ^XTMP("ASUR","R71") S ^XTMP("ASUR","R71",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM"),ASUTX=0
- D:$G(ASUN("TYP"))']"" ^ASUURANG
- Q:ASUN("BKY")="" Q:ASUN("EKY")=""
- S ASUHDA=$G(ASUN("B#"))-1 Q:ASUHDA'>0
- F S ASUHDA=$O(^ASUH(ASUHDA)) Q:ASUHDA>$G(ASUN("EKY")) Q:ASUHDA'?1N.N D
- .D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']"" Q:ASUT("TRCD")'="31"
- .S ASUMS("E#","STA")=ASUT(ASUT,"PT","STA"),ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX") D ^ASUMSTRD
- .S ^XTMP("ASUR","R71",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUL(10,"SLC")_ASUL(9,"ACG"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- Q
- ASURD71P ; IHS/ITSC/LMH -RPT 70 ISS/SHIP/INV DOC ;
- +1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
- +2 ;This routine formats and prints report 71, Backorder Release
- +3 ;Invoice/Shipping list.
- EN ;EP;PRIMARY ENTRY POINT FOR REPORT 71
- +1 IF '$DATA(IO)
- DO HOME^%ZIS
- +2 IF '$DATA(DUZ(2))
- WRITE !,"Report must be run from Kernel option"
- QUIT
- +3 IF '$DATA(ASUL(1,"AR","AP"))
- DO SETAREA^ASULARST
- +4 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
- IF ASUK("PTRSEL")]""
- GOTO PSER
- +5 SET ZTRTN="PSER^ASURD71P"
- SET ZTDESC="SAMS RPT 71"
- DO O^ASUUZIS
- +6 IF POP
- SET IOP=$IO
- DO ^%ZIS
- QUIT
- +7 IF ASUK(ASUK("PTR"),"Q")
- QUIT
- PSER ;EP;FOR TASKMAN QUEUE OF PRINT
- +1 DO U^ASUUZIS
- SET ASUC("LN")=IOSL+1
- SET ASUX("RPT")="R71"
- SET ASUT="ISB"
- SET ASUP0="INVOICE^ASURD71P"
- SET ASUHD="HEADER^ASURD71P"
- DO P7^ASURD70I
- +2 SET ASUX("DT")=$PIECE($GET(^XTMP("ASUR","R71",0)),U,2)
- +3 IF ASUX("DT")']""
- Begin DoDot:1
- +4 DO HEADER
- IF $DATA(DUOUT)
- QUIT
- WRITE !,"NO DATA FOR REPORT 71"
- End DoDot:1
- +5 IF '$TEST
- Begin DoDot:1
- +6 DO READX^ASURD70P
- End DoDot:1
- +7 KILL ASUC,ASUF,ASUX,ASUV,ASUP0,ASUHD,ASUTX,DIC,DA,X,Y
- FOR X=3:1:22
- KILL ASUL(X)
- +8 DO PAZ^ASUURHDR
- IF ASUK("PTRSEL")]""
- WRITE @IOF
- QUIT
- +9 DO C^ASUUZIS
- +10 QUIT
- INVOICE ;EP ;INVOICE
- +1 SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY","ISS"))
- IF ASUT(ASUT,"QTY","ISS")']""
- SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY"))
- +2 SET ASUC(0,"UCS")=$SELECT(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FNUMBER(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))
- +3 IF ASUT(ASUT,"QTY","ISS")>0
- Begin DoDot:1
- +4 SET ASUC(0,"VAL")=$GET(ASUC(0,"VAL"))+ASUT(ASUT,"VAL")
- End DoDot:1
- +5 SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+ASUT(ASUT,"QTY","REQ")
- SET ASUC(0,"QTYISS")=$GET(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")
- +6 IF (ASUT(ASUT,"B/O")>0)&(ASUT(ASUT,"QTY","ISS")=0)
- SET ASUC(0,"QTYREQ")=ASUC
- +7 IF (ASUT(ASUT,"B/O")>0)&(ASUT(ASUT,"QTY","ISS")=0)
- SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+$GET(ASUT(ASUT,"B/O"))
- +8 IF ASUT(ASUT,"QTY","ISS")'>0
- SET ASUT(ASUT,"QTY","ISS")=0
- +9 IF ASUT(ASUT,"QTY","ISS")=0
- SET ASUC(0,"OUT")=$GET(ASUC(0,"OUT"))+1
- +10 IF ASUT(ASUT,"FPN")="P"
- SET ASUC(0,"PART")=$GET(ASUC(0,"PART"))+1
- +11 SET ASUC(0,"ITEM")=$GET(ASUC(0,"ITEM"))+1
- +12 DO IDXBK^ASURD70P
- +13 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)
- +14 KILL ASUC(0)
- +15 QUIT
- +1 USE IO
- SET ASUC("PG")=ASUC("PG")+1
- SET ASUC("LN")=0
- IF ASUC("PG")>1
- DO PAZ^ASUURHDR
- IF $DATA(DUOUT)
- QUIT
- WRITE @IOF
- +2 WRITE !?1,"REPORT #71 BACK ORDER ISSUE/SHIPPING/INVOICE DOCUMENT"
- +3 SET Y=ASUX("DT")
- XECUTE ^DD("DD")
- WRITE ?60,Y,?73,"PAGE ",ASUC("PG")
- +4 WRITE !?3,"AREA ",ASUL(1,"AR","AP"),?15,ASUL(1,"AR","NM")
- +5 IF ASUX("STA")']""
- QUIT
- +6 WRITE ?40,"STATION ",ASUL(2,"STA","CD"),?51,ASUL(2,"STA","NM")
- +7 WRITE !?1,"REQUISITIONER: LOC ",$GET(ASUL(18,"SST"))," -",?26,$GET(ASUL(18,"SST","NM"))
- +8 WRITE ?48,"DATE OF REQUEST: "
- SET Y=ASUT(ASUT,"DTR")
- XECUTE ^DD("DD")
- WRITE ?66,Y
- +9 WRITE !!?1,"CAN ",?6,$GET(ASUT(ASUT,"CAN")),?15,"USER ",?19,$GET(ASUL(19,"USR")),?24,"-",?26,$GET(ASUL(19,"USR","NM")),?49,"REQUEST NO. ",?61,$GET(ASUT(ASUT,"RQN"))
- +10 WRITE !!?1,"SSA ",?6,$GET(ASUT(ASUT,"SSA")),?10,"CONTRACT/GRANT NO: ",?30,$GET(ASUT(ASUT,"CTG"))
- +11 WRITE ?48,"VOUCHER NO: ",?60,ASUV("VOU")
- +12 IF ASUF("BK")=1!(ASUF("END")=1)
- Begin DoDot:1
- +13 SET ASUC("LN")=ASUC("LN")+7
- WRITE !!?27,"VOUCHER NUMBER CONTROL SHEET",!!?18,"NO LI LI NO LI ISSUE ISSUE DOC"
- +14 WRITE !?1,"STORAGE LOC ITEMS OUTS PARTIALS VALUE ASSIGNED TO DATE"
- SET ASUC("LN")=ASUC("LN")+5
- End DoDot:1
- +15 IF '$TEST
- Begin DoDot:1
- +16 IF ASUF("BK")=2
- WRITE !!?23,"LISTING OF ORDER QUANTITY CHANGES"
- SET ASUC("LN")=ASUC("LN")+2
- +17 IF '$TEST
- WRITE !!?1,"STORAGE LOCATION:",?20,$GET(ASUL(10,"SLC","NM"))
- +18 WRITE !!!?3,"INDEX",?36,"QUANT",?46,"QUANT",?56,"UNIT",?66,"TOTAL"
- +19 WRITE !?2,"NUMBER DESCRIPTION",?30,"UI",?36,"B/O",?45,"ISSUED",?56,"COST",?67,"COST",?73,"REMARKS"
- +20 WRITE !,"________________________________________________________________________________"
- +21 SET ASUC("LN")=ASUC("LN")+14
- SET ASUF("HDR")=0
- End DoDot:1
- +22 QUIT
- CMPT ;EP ;SORT,SLC,LOC
- +1 KILL ^XTMP("ASUR","R71")
- SET ^XTMP("ASUR","R71",0)=ASUK("DT","FM")+10000_U_ASUK("DT","FM")
- SET ASUTX=0
- +2 IF $GET(ASUN("TYP"))']""
- DO ^ASUURANG
- +3 IF ASUN("BKY")=""
- QUIT
- IF ASUN("EKY")=""
- QUIT
- +4 SET ASUHDA=$GET(ASUN("B#"))-1
- IF ASUHDA'>0
- QUIT
- +5 FOR
- SET ASUHDA=$ORDER(^ASUH(ASUHDA))
- IF ASUHDA>$GET(ASUN("EKY"))
- QUIT
- IF ASUHDA'?1N.N
- QUIT
- Begin DoDot:1
- +6 DO READ^ASU0TRRD(.ASUHDA,"H")
- IF $GET(ASUT)']""
- QUIT
- IF ASUT("TRCD")'="31"
- QUIT
- +7 SET ASUMS("E#","STA")=ASUT(ASUT,"PT","STA")
- SET ASUMS("E#","IDX")=ASUT(ASUT,"PT","IDX")
- DO ^ASUMSTRD
- +8 SET ^XTMP("ASUR","R71",ASUT(ASUT,"PT","STA"),ASUT(ASUT,"PT","SST"),ASUT(ASUT,"VOU"),ASUL(10,"SLC")_ASUL(9,"ACG"),ASUT(ASUT,"PT","IDX"),ASUHDA)=ASUHDA
- End DoDot:1
- +9 QUIT
