- 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
