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
