ASUVOLRV ; IHS/ITSC/LMH -ONLINE REVIEW ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility which allows online Inventory Master file
;review.
D:'$D(U) ^XBKVAR
I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) Q
F D Q:$D(DTOUT)!($D(DUOUT))
.S ASUC("LN")=0
.D CLS^ASUUHDG
.S DIR("A")="REVIEW INVENTORY FOR WHAT ACCOUNT? "
.S DIR(0)="PO^9002039.09:MXEZ"
.S DIR("?")="Enter valid Account Code "
.D ^DIR K DIR
.Q:$D(DTOUT)!($D(DUOUT))
.I X="" S DUOUT=1 Q
.I Y>0 D
..S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
..D ACC^ASULDIRF(ASUMV("ACC"))
..Q:ASUMV("E#","ASA")=""
..D SLCL
..D PAUSE
.E D
..W !,"INVALID ACCOUNT CODE -ENTER '?' TO SEE VALID ACCOUNTS"
..D PAUSE
G EXIT
SLCL ;
D ACCOUNT^ASUV9IMR
I ASUF("ACC")=0 D Q
.W !!,"NO INVENTORY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
.D PAUSE
S:ASUC("LN")'=0 ASUC("LN")=20
S ASUMV("E#","SLC")=0
F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D Q:$D(DUOUT) Q:$D(DTOUT)
.S ASUMV("SLC")=$P(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0),U)
.S ASUMV("E#","INDX")=0
.F S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N D Q:$D(DUOUT) Q:$D(DTOUT)
..D INDEX^ASUV9IMR,READ^ASUMXDIO
..S ASUV("CNT","LST")=$S($L(ASUMV("CNT","2ND"))>0:ASUMV("CNT","2ND"),1:ASUMV("CNT","1ST"))
..S ASUV("VAL","DIF")=ASUMV("QTY","DIF")*ASUMV("U/C")
..I ASUC("LN")>19 S DIR(0)="E" D ^DIR K DIR D CLS^ASUUHDG S ASUC("LN")=0
..Q:$D(DTOUT) Q:$D(DUOUT)
..I ASUC("LN")=0 D
...W !?12,"ACCOUNT ",ASUMX("ACC")," INVENTORY RECORD -FOR "
...W $E(ASUMV("INVBEG"),4,5),"-",$E(ASUMV("INVBEG"),6,7),"-",$E(ASUMV("INVBEG"),2,3),!
..D DISPLAY
Q
DISPLAY ;
W !,"INDEX NO: ",$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6),?19,"DESC: ",ASUMX("DESC",1)," ",ASUMX("DESC",2)
W !?5,"SLC: ",ASUMV("SLC"),?17,"UI: ",ASUMX("AR U/I")
W ?30,"PHY CNT: ",?40,$J($FN(ASUV("CNT","LST"),","),8)
W ?55,"BGN BAL: ",?65,$J($FN(ASUMV("QTY","STAM"),","),8)
W !?5,"UNIT COST: ",$J($FN(ASUMV("U/C"),",",2),8)
W ?30,"RSCH QTY: ",?40,$J($FN(ASUMV("ADJQTY"),","),8),!
;W ?55,"ADJ QTY: ",?65,$J($FN(ASUMV("QTY","DIF"),","),8)
;S ASUV("END BAL")=ASUMV("QTY","STAM")+ASUMV("QTY","DIF")
;S ASUV("END VAL")=ASUV("END BAL")*ASUMV("U/C")
;W !?5,"END VALUE: ",$J($FN(ASUV("END VAL"),",",2),12)
;W ?30,"ADJ QTY: ",?40,$J($FN(ASUMV("QTY","DIF"),","),8)
;W ;?55,"END BAL: ",?65,$J($FN(ASUV("END BAL"),","),8),!
S ASUC("LN")=ASUC("LN")+4
Q
PAUSE ;
S DIR(0)="E" D ^DIR K DIR
EXIT ;
D XK^ASUMXDIO
K ASUU(12),ASUV,ASUMV,ASUV,DUOUT,DTOUT,ASUMX("E#"),ASUF,ASUC
Q
ASUVOLRV ; IHS/ITSC/LMH -ONLINE REVIEW ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility which allows online Inventory Master file
+3 ;review.
+4 IF '$DATA(U)
DO ^XBKVAR
+5 IF $GET(ASUL(2,"STA","E#"))']""
DO STA^ASUV0NT
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+6 FOR
Begin DoDot:1
+7 SET ASUC("LN")=0
+8 DO CLS^ASUUHDG
+9 SET DIR("A")="REVIEW INVENTORY FOR WHAT ACCOUNT? "
+10 SET DIR(0)="PO^9002039.09:MXEZ"
+11 SET DIR("?")="Enter valid Account Code "
+12 DO ^DIR
KILL DIR
+13 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+14 IF X=""
SET DUOUT=1
QUIT
+15 IF Y>0
Begin DoDot:2
+16 SET ASUMV("ACC")=$PIECE(Y,U)
SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
+17 DO ACC^ASULDIRF(ASUMV("ACC"))
+18 IF ASUMV("E#","ASA")=""
QUIT
+19 DO SLCL
+20 DO PAUSE
End DoDot:2
+21 IF '$TEST
Begin DoDot:2
+22 WRITE !,"INVALID ACCOUNT CODE -ENTER '?' TO SEE VALID ACCOUNTS"
+23 DO PAUSE
End DoDot:2
End DoDot:1
IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+24 GOTO EXIT
SLCL ;
+1 DO ACCOUNT^ASUV9IMR
+2 IF ASUF("ACC")=0
Begin DoDot:1
+3 WRITE !!,"NO INVENTORY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
+4 DO PAUSE
End DoDot:1
QUIT
+5 IF ASUC("LN")'=0
SET ASUC("LN")=20
+6 SET ASUMV("E#","SLC")=0
+7 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")'?1N.N
QUIT
Begin DoDot:1
+8 SET ASUMV("SLC")=$PIECE(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0),U)
+9 SET ASUMV("E#","INDX")=0
+10 FOR
SET ASUMV("E#","INDX")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,ASUMV("E#","INDX")))
IF ASUMV("E#","INDX")'?1N.N
QUIT
Begin DoDot:2
+11 DO INDEX^ASUV9IMR
DO READ^ASUMXDIO
+12 SET ASUV("CNT","LST")=$SELECT($LENGTH(ASUMV("CNT","2ND"))>0:ASUMV("CNT","2ND"),1:ASUMV("CNT","1ST"))
+13 SET ASUV("VAL","DIF")=ASUMV("QTY","DIF")*ASUMV("U/C")
+14 IF ASUC("LN")>19
SET DIR(0)="E"
DO ^DIR
KILL DIR
DO CLS^ASUUHDG
SET ASUC("LN")=0
+15 IF $DATA(DTOUT)
QUIT
IF $DATA(DUOUT)
QUIT
+16 IF ASUC("LN")=0
Begin DoDot:3
+17 WRITE !?12,"ACCOUNT ",ASUMX("ACC")," INVENTORY RECORD -FOR "
+18 WRITE $EXTRACT(ASUMV("INVBEG"),4,5),"-",$EXTRACT(ASUMV("INVBEG"),6,7),"-",$EXTRACT(ASUMV("INVBEG"),2,3),!
End DoDot:3
+19 DO DISPLAY
End DoDot:2
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
End DoDot:1
IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+20 QUIT
DISPLAY ;
+1 WRITE !,"INDEX NO: ",$EXTRACT(ASUMX("IDX"),1,5),".",$EXTRACT(ASUMX("IDX"),6,6),?19,"DESC: ",ASUMX("DESC",1)," ",ASUMX("DESC",2)
+2 WRITE !?5,"SLC: ",ASUMV("SLC"),?17,"UI: ",ASUMX("AR U/I")
+3 WRITE ?30,"PHY CNT: ",?40,$JUSTIFY($FNUMBER(ASUV("CNT","LST"),","),8)
+4 WRITE ?55,"BGN BAL: ",?65,$JUSTIFY($FNUMBER(ASUMV("QTY","STAM"),","),8)
+5 WRITE !?5,"UNIT COST: ",$JUSTIFY($FNUMBER(ASUMV("U/C"),",",2),8)
+6 WRITE ?30,"RSCH QTY: ",?40,$JUSTIFY($FNUMBER(ASUMV("ADJQTY"),","),8),!
+7 ;W ?55,"ADJ QTY: ",?65,$J($FN(ASUMV("QTY","DIF"),","),8)
+8 ;S ASUV("END BAL")=ASUMV("QTY","STAM")+ASUMV("QTY","DIF")
+9 ;S ASUV("END VAL")=ASUV("END BAL")*ASUMV("U/C")
+10 ;W !?5,"END VALUE: ",$J($FN(ASUV("END VAL"),",",2),12)
+11 ;W ?30,"ADJ QTY: ",?40,$J($FN(ASUMV("QTY","DIF"),","),8)
+12 ;W ;?55,"END BAL: ",?65,$J($FN(ASUV("END BAL"),","),8),!
+13 SET ASUC("LN")=ASUC("LN")+4
+14 QUIT
PAUSE ;
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
EXIT ;
+1 DO XK^ASUMXDIO
+2 KILL ASUU(12),ASUV,ASUMV,ASUV,DUOUT,DTOUT,ASUMX("E#"),ASUF,ASUC
+3 QUIT
