ASURD70P ; IHS/ITSC/LMH -RPT 70 ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine formats and prints report 70, Replenishment Pre Posted
;Issues Invoice/Shipping list.
D:'$D(IO) 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^ASURD70P",ZTDESC="SAMS RPT 70" 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,DATE^ASUUDATE S ASUX("RPT")="R70",ASUT="ISS",ASUP0="INVOICE^ASURD70P",ASUHD="HEADER^ASURD70P" D P7^ASURD70I
S Y=$P(^XTMP("ASUR",ASUX("RPT"),0),U,2) X ^DD("DD") S ASUX("DT")=Y
S X=$O(^XTMP("ASUR",ASUX("RPT"),0)) I X']"" D
.W @IOF,!!,"NO DATA FOR REPORT 70"
E D READX
K ASUU,ASUT,ASUC,ASUCL,ASUV,ASUF,ASUA,DIC,DA,X,Y F X=3:1:22 K ASUL(X)
D PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
D ^ASURD70I I $G(ASUK("PTRSEL"))]"" W @IOF Q
D C^ASUUZIS
Q
READX ;EP ;READ TMP GLOBAL
S ASUX("STA")=0 F S ASUX("STA")=$O(^XTMP("ASUR",ASUX("RPT"),$G(ASUX("STA")))) Q:ASUX("STA")="" D
.I ASUX("STA")'=$G(ASUV("STA")) D
..I $G(ASUV("STA"))="" S ASUV("STA")=ASUX("STA") D STA^ASULARST(ASUX("STA"))
.S ASUX("SST")=0
.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")=""
..I $G(ASUV("SST"))'=ASUX("SST") D
...I $G(ASUV("SST"))="" S 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 $G(ASUV("VOU"))'=ASUX("VOU") S ASUF("HDR")=1,ASUC("PG")=0,ASUV("VOU")=ASUX("VOU")
...S ASUX("SLC")="" F S ASUX("SLC")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"))) Q:ASUX("SLC")="" D
....D:$G(ASUL(10,"SLC"))'=ASUX("SLC") SLC^ASULDIRR(ASUX("SLC")) S ASUV("SLC")=ASUX("SLC")
....S ASUX("IDX")=0
....F S ASUX("IDX")=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"))) Q:ASUX("IDX")="" D
.....S ASUHDA="",ASUV("IDX")=ASUX("IDX")
.....F S ASUHDA=$O(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUHDA)) Q:ASUHDA="" D
......D READ^ASU0TRRD(.ASUHDA,"H") Q:$G(ASUT)']""
......D @ASUP0
....S ASUX("IDX")=ASUV("IDX")
...D SLCBK K ASUC(1) S ASUF("BK")=1
...D LSTSLC S ASUX("SLC")=ASUV("SLC"),ASUF("BK")=2
..D SSTBK
Q
SSTBK ;Sub Station Break
I $G(ASUA("#"))>0 D
.S ASUA("#")="",ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1,ASUF("BK")=3
.F S ASUA("#")=$O(ASUAN($G(ASUA("#")))) Q:ASUA("#")="" D
..S ASUV("#")=$G(ASUA("#")),ASUADA=$P(ASUAN(ASUA("#")),U) D READ^ASU0TRRD(.ASUADA,"H")
..S ASUV("RMK",0)=$P(ASUAN(ASUA("#")),U,2)
..S ASUV("RMK",1)=$P(ASUAN(ASUA("#")),U,3)
..S ASUC(0,"QTYREQ")=ASUT(ASUT,"QTY","REQ")
..S ASUC(0,"QTYISS")=$S(ASUV("RMK",0)="B/O O/F":0,1:ASUT(ASUT,"QTY","ISS"))
..S ASUC(0,"UCS")=$S(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FN(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))
..S ASUC(0,"VAL")=ASUT(ASUT,"VAL"),ASUC(0,"DIF")=ASUC(0,"QTYISS")-ASUC(0,"QTYREQ")
..S ASUX("IDX")=ASUT(ASUT,"PT","IDX") D IDXBK Q:$D(DUOUT)
..K ASUAN(ASUA("#")),ASUA("#")
.W !!,"TOTAL LINE ITEMS : ",$J($FN(ASUV("#"),","),7),! S ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+3,ASUV("IDX")=ASUX("IDX")
.K ASUC(0)
.K ASUA,ASUQT(0) S ASUA("#")=0
Q
INVOICE ;EP;INVOICE
I ASUF("BK")=1 D HEADER S ASUF("BK")=0
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")
.S ASUC(0,"QTYISS")=$G(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")
I ($G(ASUT(ASUT,"QTY","REQ"))>0)&(ASUT(ASUT,"QTY","ISS")=0) S ASUC(0,"QTYREQ")=$G(ASUC(0,"QTYREQ"))+$G(ASUT(ASUT,"QTY","REQ"))
I ASUT(ASUT,"QTY","ISS")'>0 S ASUT(ASUT,"QTY","ISS")=0,ASUV("RMK",0)="STK OUT"
I ASUT(ASUT,"QTY","ISS")=0 S ASUC(0,"OUT")=$G(ASUC(0,"OUT"))+1
S ASUC(0,"ITEM")=$G(ASUC(0,"ITEM"))+1
I ASUT(ASUT,"FPN")="B" D
.S ASUT(ASUT,"FPN")="N",ASUC(0,"QTYISS")=0,ASUC(0,"PART")=$G(ASUC(0,"PART"))+1
.S ASUV("RMK",1)="B/O O/F",ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1
.S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))
I ASUT(ASUT,"FPN")="P" D
.I ASUX("RPT")="R7I" S ASUV("RMK",1)="PAR ISS"
.E S ASUV("RMK",1)="PAR B/0"
.S ASUC(0,"PART")=$G(ASUC(0,"PART"))+1,ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1
.S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))
I (ASUT(ASUT,"QTY","REQ")>0)&(ASUT(ASUT,"QTY","ISS")=0) D
.S ASUV("RMK",1)="TOT B/O",ASUS("QTYAJ")=0,ASUA("#")=$G(ASUA("#"))+1
.S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))
I ASUT(ASUT,"QTY","ADJ")="A" D
.S ASUS("QTYAJ")=1 I $G(ASUA("#"))>0 D
..I $P(ASUAN(ASUA("#")),U)=ASUHDA Q
..S ASUA("#")=$G(ASUA("#"))+1
.S ASUV("RMK",2)="QTY ADJ" S:$G(ASUA("#"))']"" ASUA("#")=1
.S ASUAN(ASUA("#"))=ASUHDA_U_$G(ASUV("RMK",0))_U_$G(ASUV("RMK",1))_U_$G(ASUV("RMK",2))
S ASUF("BK")=0
D IDXBK Q:$D(DUOUT)
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
IDXBK ;EP;INDEX
I ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") D @ASUHD Q:$D(DUOUT)
I ASUX("RPT")'="R71" D
.I $G(ASUV("RMK",1))=""&($G(ASUV("RMK",0))="") S ASUV("RMK",0)=$G(ASUV("RMK",2)) K ASUV("RMK",2)
.I $G(ASUV("RMK",0))=""&($G(ASUV("RMK",1))]"") S ASUV("RMK",0)=$G(ASUV("RMK",1)) K ASUV("RMK",1)
.I $G(ASUV("RMK",0))]""&($G(ASUV("RMK",1))]"") S ASUV("RMK",2)=$G(ASUV("RMK",1))
E S ASUV("RMK",0)=$G(ASUT(ASUT,"RMK"))
W !!?1,$E($G(ASUX("IDX")),3,7),".",$E($G(ASUX("IDX")),8,8),?30,$G(ASUMX("AR U/I"))
W ?34,$J($FN($G(ASUC(0,"QTYREQ")),",",0),6),?44,$J($FN($G(ASUC(0,"QTYISS")),",",0),6),"*",?52,$J($FN($G(ASUC(0,"UCS")),",",2),8),?62,$J($FN($G(ASUC(0,"VAL")),",",2),10),?73,$G(ASUV("RMK",0))
W !?5,$S($G(ASUMX("DESC"))]"":ASUMX("DESC"),1:$G(ASUMX("DELDS"))),?73,$S($G(ASUC(0,"DIF"))]"":$J($G(ASUC(0,"DIF")),7),1:$G(ASUV("RMK",2)))
W !,"________________________________________________________________________________"
S ASUC("LN")=ASUC("LN")+6 K ASUV("RMK")
Q
SLCBK ;EP; STORAGE LOCATION CODE BRK
S ASUC("LN")=ASUC("LN")+2
I ASUC("LN")>ASUK(ASUK("PTR"),"IOSL") D HEADER Q:$D(DUOUT)
W !!?2,"TOTAL LINE ITEMS: ",?20,$J($FN($G(ASUC(1,"ITEM")),","),5),?26,"NO. OUTS: " W ?36,$J($FN($G(ASUC(1,"OUT")),","),5),?42,"NO. PARTIALS: ",?56,$J($FN($G(ASUC(1,"PART")),","),5)
W ?62,$J($FN($G(ASUC(1,"VAL")),",",2),10)
W !!?3,"ISSUED BY:",?42,"CHECKED BY:",!?5,"DATE:",?45,"DATE:",!?5,"TIME STARTED:",?45,"TIME STARTED:",!?5,"TIME FINISHED:",?45,"TIME FINISHED:",!
S ASUC("LN")=ASUC("LN")+6
N X S X="" F S X=$O(ASUC(1,X)) Q:X']"" S ASUCL(ASUV("SLC"),X)=$G(ASUCL(ASUV("SLC"),X))+ASUC(1,X)
Q
LSTSLC ;EP ;
D @ASUHD S ASULR("SLC")=9
S ASULR("SLC")=0 F S ASULR("SLC")=$O(ASUCL(ASULR("SLC"))) Q:ASULR("SLC")']"" D
.Q:ASULR("SLC")?1N
.D SLC^ASULDIRR(ASULR("SLC")) W !!?2,$J(ASUL(10,"SLC","NM"),13)
.W ?17,$J($FN($G(ASUCL(ASULR("SLC"),"ITEM")),",",0),6)
.W ?24,$J($FN($G(ASUCL(ASULR("SLC"),"OUT")),",",0),6)
.W ?35,$J($FN($G(ASUCL(ASULR("SLC"),"PART")),",",0),6)
.W ?42,$J($FN($G(ASUCL(ASULR("SLC"),"VAL")),",",2),10)
.N X S X="" F S X=$O(ASUCL(ASULR("SLC"),X)) Q:X']"" S ASUC(2,X)=$G(ASUC(2,X))+ASUCL(ASULR("SLC"),X)
.K ASUCL(ASULR("SLC"))
S X2=0,X3=5
W !!?2,"T O T A L",?17,$J($FN($G(ASUC(2,"ITEM")),",",0),6),?24,$J($FN($G(ASUC(2,"OUT")),",",0),6)
W ?35,$J($FN($G(ASUC(2,"PART")),",",0),6),?42,$J($FN($G(ASUC(2,"VAL")),",",2),10),!
S ASUF("BK")=0,ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1,ASUV("VOU")=ASUX("VOU") K ASUC(2),ASUCL(0)
Q
S ASUC("PG")=$G(ASUC("PG"))+1,ASUC("LN")=0 D:ASUC("PG")>1 PAZ^ASUURHDR Q:$D(DUOUT) W @IOF
S ASUV("HEAD")=$S(ASUX("RPT")="R70":"70 ISSUE/SHIPPING/INVOICE DOCUMENT",1:"70I POST-POSTED ISSUE/INVOICE DOCUMENT")
W !?1,"REPORT #",ASUV("HEAD") W ?55,ASUX("DT"),?73,"PAGE ",ASUC("PG")
W !?3,"AREA ",ASUL(1,"AR","AP") W ?15,ASUL(1,"AR","NM")
W ?40,"STATION ",ASUL(2,"STA","CD"),?51,ASUL(2,"STA","NM")
W !?1,"REQUISITIONER: LOC ",ASUL(18,"SST")," -",?26,ASUL(18,"SST","NM")
W ?48,"DATE OF REQUEST: " S Y=ASUT(ASUT,"DTR") X ^DD("DD") W ?66,Y
W !!?1,"CAN ",?6,ASUT(ASUT,"CAN"),?15,"USER ",?19,ASUL(19,"USR"),?24,"-",?26,ASUL(19,"USR","NM")
W ?49,"REQUEST NO. ",?61,ASUT(ASUT,"RQN"),!!?1,"SSA ",?6,ASUT(ASUT,"SSA"),?10,"CONTRACT/GRANT NO: ",?30,ASUT(ASUT,"CTG")
W ?48,"VOUCHER NO: ",?60,ASUV("VOU")
I ASUF("BK")=2!(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")=3 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,$S(ASUX("RPT")="R71":"B/O",1:"REQ'D"),?45,"ISSUED",?56,"COST",?67,"COST",?73,"REMARKS"
.W !,"________________________________________________________________________________"
.S ASUC("LN")=ASUC("LN")+14,ASUF("HDR")=0
Q
ASURD70P ; IHS/ITSC/LMH -RPT 70 ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine formats and prints report 70, Replenishment Pre Posted
+3 ;Issues Invoice/Shipping list.
+4 IF '$DATA(IO)
DO HOME^%ZIS
IF '$DATA(DUZ(2))
WRITE !,"Report must be run from Kernel option"
QUIT
+5 IF '$DATA(ASUL(1,"AR","AP"))
DO SETAREA^ASULARST
+6 SET ASUK("PTRSEL")=$GET(ASUK("PTRSEL"))
IF ASUK("PTRSEL")]""
GOTO PSER
+7 SET ZTRTN="PSER^ASURD70P"
SET ZTDESC="SAMS RPT 70"
DO O^ASUUZIS
+8 IF POP
SET IOP=$IO
DO ^%ZIS
QUIT
+9 IF ASUK(ASUK("PTR"),"Q")
QUIT
PSER ;EP;FOR TASKMAN QUEUE OF PRINT
+1 DO U^ASUUZIS
DO DATE^ASUUDATE
SET ASUX("RPT")="R70"
SET ASUT="ISS"
SET ASUP0="INVOICE^ASURD70P"
SET ASUHD="HEADER^ASURD70P"
DO P7^ASURD70I
+2 SET Y=$PIECE(^XTMP("ASUR",ASUX("RPT"),0),U,2)
XECUTE ^DD("DD")
SET ASUX("DT")=Y
+3 SET X=$ORDER(^XTMP("ASUR",ASUX("RPT"),0))
IF X']""
Begin DoDot:1
+4 WRITE @IOF,!!,"NO DATA FOR REPORT 70"
End DoDot:1
+5 IF '$TEST
DO READX
+6 KILL ASUU,ASUT,ASUC,ASUCL,ASUV,ASUF,ASUA,DIC,DA,X,Y
FOR X=3:1:22
KILL ASUL(X)
+7 DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+8 DO ^ASURD70I
IF $GET(ASUK("PTRSEL"))]""
WRITE @IOF
QUIT
+9 DO C^ASUUZIS
+10 QUIT
READX ;EP ;READ TMP GLOBAL
+1 SET ASUX("STA")=0
FOR
SET ASUX("STA")=$ORDER(^XTMP("ASUR",ASUX("RPT"),$GET(ASUX("STA"))))
IF ASUX("STA")=""
QUIT
Begin DoDot:1
+2 IF ASUX("STA")'=$GET(ASUV("STA"))
Begin DoDot:2
+3 IF $GET(ASUV("STA"))=""
SET ASUV("STA")=ASUX("STA")
DO STA^ASULARST(ASUX("STA"))
End DoDot:2
+4 SET ASUX("SST")=0
+5 FOR
SET ASUX("SST")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST")))
IF ASUX("SST")=""
QUIT
IF $DATA(DUOUT)
QUIT
Begin DoDot:2
+6 SET ASUF("HDR")=0
SET ASUX("VOU")=""
+7 IF $GET(ASUV("SST"))'=ASUX("SST")
Begin DoDot:3
+8 IF $GET(ASUV("SST"))=""
SET ASUV("SST")=ASUX("SST")
DO SST^ASULDIRR(ASUV("SST"))
End DoDot:3
+9 SET ASUX("VOU")=""
+10 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
+11 IF $GET(ASUV("VOU"))'=ASUX("VOU")
SET ASUF("HDR")=1
SET ASUC("PG")=0
SET ASUV("VOU")=ASUX("VOU")
+12 SET ASUX("SLC")=""
FOR
SET ASUX("SLC")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC")))
IF ASUX("SLC")=""
QUIT
Begin DoDot:4
+13 IF $GET(ASUL(10,"SLC"))'=ASUX("SLC")
DO SLC^ASULDIRR(ASUX("SLC"))
SET ASUV("SLC")=ASUX("SLC")
+14 SET ASUX("IDX")=0
+15 FOR
SET ASUX("IDX")=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX")))
IF ASUX("IDX")=""
QUIT
Begin DoDot:5
+16 SET ASUHDA=""
SET ASUV("IDX")=ASUX("IDX")
+17 FOR
SET ASUHDA=$ORDER(^XTMP("ASUR",ASUX("RPT"),ASUX("STA"),ASUX("SST"),ASUX("VOU"),ASUX("SLC"),ASUX("IDX"),ASUHDA))
IF ASUHDA=""
QUIT
Begin DoDot:6
+18 DO READ^ASU0TRRD(.ASUHDA,"H")
IF $GET(ASUT)']""
QUIT
+19 DO @ASUP0
End DoDot:6
End DoDot:5
+20 SET ASUX("IDX")=ASUV("IDX")
End DoDot:4
+21 DO SLCBK
KILL ASUC(1)
SET ASUF("BK")=1
+22 DO LSTSLC
SET ASUX("SLC")=ASUV("SLC")
SET ASUF("BK")=2
End DoDot:3
+23 DO SSTBK
End DoDot:2
End DoDot:1
+24 QUIT
SSTBK ;Sub Station Break
+1 IF $GET(ASUA("#"))>0
Begin DoDot:1
+2 SET ASUA("#")=""
SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
SET ASUF("BK")=3
+3 FOR
SET ASUA("#")=$ORDER(ASUAN($GET(ASUA("#"))))
IF ASUA("#")=""
QUIT
Begin DoDot:2
+4 SET ASUV("#")=$GET(ASUA("#"))
SET ASUADA=$PIECE(ASUAN(ASUA("#")),U)
DO READ^ASU0TRRD(.ASUADA,"H")
+5 SET ASUV("RMK",0)=$PIECE(ASUAN(ASUA("#")),U,2)
+6 SET ASUV("RMK",1)=$PIECE(ASUAN(ASUA("#")),U,3)
+7 SET ASUC(0,"QTYREQ")=ASUT(ASUT,"QTY","REQ")
+8 SET ASUC(0,"QTYISS")=$SELECT(ASUV("RMK",0)="B/O O/F":0,1:ASUT(ASUT,"QTY","ISS"))
+9 SET ASUC(0,"UCS")=$SELECT(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FNUMBER(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))
+10 SET ASUC(0,"VAL")=ASUT(ASUT,"VAL")
SET ASUC(0,"DIF")=ASUC(0,"QTYISS")-ASUC(0,"QTYREQ")
+11 SET ASUX("IDX")=ASUT(ASUT,"PT","IDX")
DO IDXBK
IF $DATA(DUOUT)
QUIT
+12 KILL ASUAN(ASUA("#")),ASUA("#")
End DoDot:2
+13 WRITE !!,"TOTAL LINE ITEMS : ",$JUSTIFY($FNUMBER(ASUV("#"),","),7),!
SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+3
SET ASUV("IDX")=ASUX("IDX")
+14 KILL ASUC(0)
+15 KILL ASUA,ASUQT(0)
SET ASUA("#")=0
End DoDot:1
+16 QUIT
INVOICE ;EP;INVOICE
+1 IF ASUF("BK")=1
DO HEADER
SET ASUF("BK")=0
+2 SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY","ISS"))
IF ASUT(ASUT,"QTY","ISS")']""
SET ASUT(ASUT,"QTY","ISS")=$GET(ASUT(ASUT,"QTY"))
+3 SET ASUC(0,"UCS")=$SELECT(+ASUT(ASUT,"QTY","ISS")=0:"0.00",1:$FNUMBER(ASUT(ASUT,"VAL")/ASUT(ASUT,"QTY","ISS"),"",2))
+4 IF ASUT(ASUT,"QTY","ISS")>0
Begin DoDot:1
+5 SET ASUC(0,"VAL")=$GET(ASUC(0,"VAL"))+ASUT(ASUT,"VAL")
+6 SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+ASUT(ASUT,"QTY","REQ")
+7 SET ASUC(0,"QTYISS")=$GET(ASUC(0,"QTYISS"))+ASUT(ASUT,"QTY","ISS")
End DoDot:1
+8 IF ($GET(ASUT(ASUT,"QTY","REQ"))>0)&(ASUT(ASUT,"QTY","ISS")=0)
SET ASUC(0,"QTYREQ")=$GET(ASUC(0,"QTYREQ"))+$GET(ASUT(ASUT,"QTY","REQ"))
+9 IF ASUT(ASUT,"QTY","ISS")'>0
SET ASUT(ASUT,"QTY","ISS")=0
SET ASUV("RMK",0)="STK OUT"
+10 IF ASUT(ASUT,"QTY","ISS")=0
SET ASUC(0,"OUT")=$GET(ASUC(0,"OUT"))+1
+11 SET ASUC(0,"ITEM")=$GET(ASUC(0,"ITEM"))+1
+12 IF ASUT(ASUT,"FPN")="B"
Begin DoDot:1
+13 SET ASUT(ASUT,"FPN")="N"
SET ASUC(0,"QTYISS")=0
SET ASUC(0,"PART")=$GET(ASUC(0,"PART"))+1
+14 SET ASUV("RMK",1)="B/O O/F"
SET ASUS("QTYAJ")=0
SET ASUA("#")=$GET(ASUA("#"))+1
+15 SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))
End DoDot:1
+16 IF ASUT(ASUT,"FPN")="P"
Begin DoDot:1
+17 IF ASUX("RPT")="R7I"
SET ASUV("RMK",1)="PAR ISS"
+18 IF '$TEST
SET ASUV("RMK",1)="PAR B/0"
+19 SET ASUC(0,"PART")=$GET(ASUC(0,"PART"))+1
SET ASUS("QTYAJ")=0
SET ASUA("#")=$GET(ASUA("#"))+1
+20 SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))
End DoDot:1
+21 IF (ASUT(ASUT,"QTY","REQ")>0)&(ASUT(ASUT,"QTY","ISS")=0)
Begin DoDot:1
+22 SET ASUV("RMK",1)="TOT B/O"
SET ASUS("QTYAJ")=0
SET ASUA("#")=$GET(ASUA("#"))+1
+23 SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))
End DoDot:1
+24 IF ASUT(ASUT,"QTY","ADJ")="A"
Begin DoDot:1
+25 SET ASUS("QTYAJ")=1
IF $GET(ASUA("#"))>0
Begin DoDot:2
+26 IF $PIECE(ASUAN(ASUA("#")),U)=ASUHDA
QUIT
+27 SET ASUA("#")=$GET(ASUA("#"))+1
End DoDot:2
+28 SET ASUV("RMK",2)="QTY ADJ"
IF $GET(ASUA("#"))']""
SET ASUA("#")=1
+29 SET ASUAN(ASUA("#"))=ASUHDA_U_$GET(ASUV("RMK",0))_U_$GET(ASUV("RMK",1))_U_$GET(ASUV("RMK",2))
End DoDot:1
+30 SET ASUF("BK")=0
+31 DO IDXBK
IF $DATA(DUOUT)
QUIT
+32 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)
+33 KILL ASUC(0)
+34 QUIT
IDXBK ;EP;INDEX
+1 IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
DO @ASUHD
IF $DATA(DUOUT)
QUIT
+2 IF ASUX("RPT")'="R71"
Begin DoDot:1
+3 IF $GET(ASUV("RMK",1))=""&($GET(ASUV("RMK",0))="")
SET ASUV("RMK",0)=$GET(ASUV("RMK",2))
KILL ASUV("RMK",2)
+4 IF $GET(ASUV("RMK",0))=""&($GET(ASUV("RMK",1))]"")
SET ASUV("RMK",0)=$GET(ASUV("RMK",1))
KILL ASUV("RMK",1)
+5 IF $GET(ASUV("RMK",0))]""&($GET(ASUV("RMK",1))]"")
SET ASUV("RMK",2)=$GET(ASUV("RMK",1))
End DoDot:1
+6 IF '$TEST
SET ASUV("RMK",0)=$GET(ASUT(ASUT,"RMK"))
+7 WRITE !!?1,$EXTRACT($GET(ASUX("IDX")),3,7),".",$EXTRACT($GET(ASUX("IDX")),8,8),?30,$GET(ASUMX("AR U/I"))
+8 WRITE ?34,$JUSTIFY($FNUMBER($GET(ASUC(0,"QTYREQ")),",",0),6),?44,$JUSTIFY($FNUMBER($GET(ASUC(0,"QTYISS")),",",0),6),"*",?52,$JUSTIFY($FNUMBER($GET(ASUC(0,"UCS")),",",2),8),?62,$JUSTIFY($FNUMBER($GET(ASUC(0,"VAL")),",",2),10),?73,$GET(ASUV("RMK"
,0))
+9 WRITE !?5,$SELECT($GET(ASUMX("DESC"))]"":ASUMX("DESC"),1:$GET(ASUMX("DELDS"))),?73,$SELECT($GET(ASUC(0,"DIF"))]"":$JUSTIFY($GET(ASUC(0,"DIF")),7),1:$GET(ASUV("RMK",2)))
+10 WRITE !,"________________________________________________________________________________"
+11 SET ASUC("LN")=ASUC("LN")+6
KILL ASUV("RMK")
+12 QUIT
SLCBK ;EP; STORAGE LOCATION CODE BRK
+1 SET ASUC("LN")=ASUC("LN")+2
+2 IF ASUC("LN")>ASUK(ASUK("PTR"),"IOSL")
DO HEADER
IF $DATA(DUOUT)
QUIT
+3 WRITE !!?2,"TOTAL LINE ITEMS: ",?20,$JUSTIFY($FNUMBER($GET(ASUC(1,"ITEM")),","),5),?26,"NO. OUTS: "
WRITE ?36,$JUSTIFY($FNUMBER($GET(ASUC(1,"OUT")),","),5),?42,"NO. PARTIALS: ",?56,$JUSTIFY($FNUMBER($GET(ASUC(1,"PART")),","),5)
+4 WRITE ?62,$JUSTIFY($FNUMBER($GET(ASUC(1,"VAL")),",",2),10)
+5 WRITE !!?3,"ISSUED BY:",?42,"CHECKED BY:",!?5,"DATE:",?45,"DATE:",!?5,"TIME STARTED:",?45,"TIME STARTED:",!?5,"TIME FINISHED:",?45,"TIME FINISHED:",!
+6 SET ASUC("LN")=ASUC("LN")+6
+7 NEW X
SET X=""
FOR
SET X=$ORDER(ASUC(1,X))
IF X']""
QUIT
SET ASUCL(ASUV("SLC"),X)=$GET(ASUCL(ASUV("SLC"),X))+ASUC(1,X)
+8 QUIT
LSTSLC ;EP ;
+1 DO @ASUHD
SET ASULR("SLC")=9
+2 SET ASULR("SLC")=0
FOR
SET ASULR("SLC")=$ORDER(ASUCL(ASULR("SLC")))
IF ASULR("SLC")']""
QUIT
Begin DoDot:1
+3 IF ASULR("SLC")?1N
QUIT
+4 DO SLC^ASULDIRR(ASULR("SLC"))
WRITE !!?2,$JUSTIFY(ASUL(10,"SLC","NM"),13)
+5 WRITE ?17,$JUSTIFY($FNUMBER($GET(ASUCL(ASULR("SLC"),"ITEM")),",",0),6)
+6 WRITE ?24,$JUSTIFY($FNUMBER($GET(ASUCL(ASULR("SLC"),"OUT")),",",0),6)
+7 WRITE ?35,$JUSTIFY($FNUMBER($GET(ASUCL(ASULR("SLC"),"PART")),",",0),6)
+8 WRITE ?42,$JUSTIFY($FNUMBER($GET(ASUCL(ASULR("SLC"),"VAL")),",",2),10)
+9 NEW X
SET X=""
FOR
SET X=$ORDER(ASUCL(ASULR("SLC"),X))
IF X']""
QUIT
SET ASUC(2,X)=$GET(ASUC(2,X))+ASUCL(ASULR("SLC"),X)
+10 KILL ASUCL(ASULR("SLC"))
End DoDot:1
+11 SET X2=0
SET X3=5
+12 WRITE !!?2,"T O T A L",?17,$JUSTIFY($FNUMBER($GET(ASUC(2,"ITEM")),",",0),6),?24,$JUSTIFY($FNUMBER($GET(ASUC(2,"OUT")),",",0),6)
+13 WRITE ?35,$JUSTIFY($FNUMBER($GET(ASUC(2,"PART")),",",0),6),?42,$JUSTIFY($FNUMBER($GET(ASUC(2,"VAL")),",",2),10),!
+14 SET ASUF("BK")=0
SET ASUC("LN")=ASUK(ASUK("PTR"),"IOSL")+1
SET ASUV("VOU")=ASUX("VOU")
KILL ASUC(2),ASUCL(0)
+15 QUIT
+1 SET ASUC("PG")=$GET(ASUC("PG"))+1
SET ASUC("LN")=0
IF ASUC("PG")>1
DO PAZ^ASUURHDR
IF $DATA(DUOUT)
QUIT
WRITE @IOF
+2 SET ASUV("HEAD")=$SELECT(ASUX("RPT")="R70":"70 ISSUE/SHIPPING/INVOICE DOCUMENT",1:"70I POST-POSTED ISSUE/INVOICE DOCUMENT")
+3 WRITE !?1,"REPORT #",ASUV("HEAD")
WRITE ?55,ASUX("DT"),?73,"PAGE ",ASUC("PG")
+4 WRITE !?3,"AREA ",ASUL(1,"AR","AP")
WRITE ?15,ASUL(1,"AR","NM")
+5 WRITE ?40,"STATION ",ASUL(2,"STA","CD"),?51,ASUL(2,"STA","NM")
+6 WRITE !?1,"REQUISITIONER: LOC ",ASUL(18,"SST")," -",?26,ASUL(18,"SST","NM")
+7 WRITE ?48,"DATE OF REQUEST: "
SET Y=ASUT(ASUT,"DTR")
XECUTE ^DD("DD")
WRITE ?66,Y
+8 WRITE !!?1,"CAN ",?6,ASUT(ASUT,"CAN"),?15,"USER ",?19,ASUL(19,"USR"),?24,"-",?26,ASUL(19,"USR","NM")
+9 WRITE ?49,"REQUEST NO. ",?61,ASUT(ASUT,"RQN"),!!?1,"SSA ",?6,ASUT(ASUT,"SSA"),?10,"CONTRACT/GRANT NO: ",?30,ASUT(ASUT,"CTG")
+10 WRITE ?48,"VOUCHER NO: ",?60,ASUV("VOU")
+11 IF ASUF("BK")=2!(ASUF("END")=1)
Begin DoDot:1
+12 SET ASUC("LN")=ASUC("LN")+7
WRITE !!?27,"VOUCHER NUMBER CONTROL SHEET",!!?18,"NO LI LI NO LI ISSUE ISSUE DOC"
+13 WRITE !?1,"STORAGE LOC ITEMS OUTS PARTIALS VALUE ASSIGNED TO DATE"
SET ASUC("LN")=ASUC("LN")+5
End DoDot:1
+14 IF '$TEST
Begin DoDot:1
+15 IF ASUF("BK")=3
WRITE !!?23,"LISTING OF ORDER QUANTITY CHANGES"
SET ASUC("LN")=ASUC("LN")+2
+16 IF '$TEST
WRITE !!?1,"STORAGE LOCATION:",?20,$GET(ASUL(10,"SLC","NM"))
+17 WRITE !!!?3,"INDEX",?36,"QUANT",?46,"QUANT",?56,"UNIT",?66,"TOTAL"
+18 WRITE !?2,"NUMBER DESCRIPTION",?30,"UI",?36,$SELECT(ASUX("RPT")="R71":"B/O",1:"REQ'D"),?45,"ISSUED",?56,"COST",?67,"COST",?73,"REMARKS"
+19 WRITE !,"________________________________________________________________________________"
+20 SET ASUC("LN")=ASUC("LN")+14
SET ASUF("HDR")=0
End DoDot:1
+21 QUIT
