ASUV0NT ; IHS/ASDST/WAR -INVTR INITIALIZE INVENTORY ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000
;This routine initializes the Physical Inventory Master (in ^ASUMV) for
;an account after verifying there is no current inventory active for
;that account. The Physical Inventory Master contains information from
;the Station Master (in ^ASUMS) concerning quantity and value at the
;beginning of an inventory. Once the Physical Inventory Master is
;initialized, a Physical Inventory can be conducted at the same time
;items are being issued from the account. It in effect 'freezes' the
;inventory information from the Station master for the items of that
;account.
D:'$D(DT) ^XBKVAR
D:$G(ASUK("DT","FM"))']"" DATE^ASUUDATE
S ASUV("DT")=ASUK("DT","FM")
D CLS^ASUUHDG
I $G(ASUL(2,"STA","E#"))']"" D STA I $D(DTOUT)!($D(DUOUT)) G EXIT
S DIC("A")="CREATE AN INVENTORY MASTER FILE FOR WHAT ACCOUNT? "
S DIC="9002039.09",DIC(0)="AMEZQ"
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT)) G EXIT
I Y>0 D
.S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
.D ACC^ASULDIRF(ASUMV("ACC"))
E G EXIT
G:ASUMV("E#","ASA")="" EXIT
S ASUMS("E#","STA")=$O(^ASUMS("B",ASUL(2,"STA","E#"),"")) ;;CHG 3/13/95 CSC
Q:ASUMS("E#","STA")'?1N.N
I $D(^ASUMV(ASUMV("E#","ASA"),0)) D
.D ACCOUNT^ASUV9IMR
.I ASUMV("MODE")=4 D
..D REPACCT^ASUV9IMW
.E D
..W !!,"YOU HAVE REQUESTED AN PHYSICAL INVENTORY BE INITIALIZED, BUT AN"
..W !,"INVENTORY IS ALREADY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
..W !,"THE STATUS OF THAT INVENTORY IS ",$S(ASUMV("MODE")=0:"INITIALIZED",ASUMV("MODE")=1:"INITIAL COUNT",ASUMV("MODE")=2:"RE-COUNT",ASUMV("MODE")=3:"RESEARCH",1:"COMPLETE")," MODE",!
..S DIR("A")="DO YOU WANT TO CANCEL THE CURRENT INVENTORY AND START AGAIN"
..S DIR(0)="Y",DIR("B")="N"
..S DIR("?")="Answer 'Y' to cancel the inventory or 'N' end the Inventory file Initialzation"
..D ^DIR K DIR
..Q:$D(DUOUT) Q:$D(DTOUT)
..I Y=0 S DUOUT=1 Q
..W !!,"WARNING! THIS WILL CAUSE ALL COUNTS TO BE LOST FOR THE CURRENT INVENTORY!",!!
..S DIR("A")="ARE YOU SURE YOU WANT TO CANCEL THE CURRENT INVENTORY"
..S DIR(0)="Y",DIR("B")="N"
..D ^DIR K DIR
..Q:$D(DUOUT) Q:$D(DTOUT)
..I Y=0 S DUOUT=1 Q
..D REPACCT^ASUV9IMW
E D
.D NEWACCT^ASUV9IMW
G:$D(DUOUT)!($D(DTOUT)) EXIT
W !
S DIR("A")="ENTER A VOUCHER NUMBER FOR THE INVENTORY ADJUSTMENTS"
S DIR(0)="F^8:8^D VOU^ASUJVALF(.X,.DDSERROR)"
S DIR("?")="Voucher Number must be 8 numeric digits, not all zeors in format FYMMNNNN"
D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) D DELACCT^ASUV9IMW G EXIT
S ASUR("VOU")=X
S ASUMV("VOU")=ASUR("VOU")
S ASUMV("MODE")=0
D ACCOUNT^ASUV9IMW
;D ASUV0NT1
ASUV0NT1 ;
S ASUMS("E#","STA")=$O(^ASUMS("B",ASUL(2,"STA","E#"),"")) ;;CHG 3/13/95 CSC
Q:ASUMS("E#","STA")'?1N.N
S (ASUC("ITEMS"),ASUMS("E#","IDX"))=0
F S ASUMS("E#","IDX")=$O(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX"))) Q:((ASUMS("E#","IDX")'?1N.N)!(ASUMS("E#","IDX")[999999)) D
.S (ASUMV("IDX"),ASUMX("E#","IDX"))=ASUMS("E#","IDX") D READ^ASUMXDIO
.; ** LMH 6/15/00 QUIT IF INDEX MSTR. HAS BEEN DELETED **
.Q:ASUMX("IDX")[999999!(ASUMX("IDX")="")
.Q:'$D(ASUMX("ACC"))
.Q:ASUMV("ACC")'=ASUMX("ACC")
.S ASUC("ITEMS")=ASUC("ITEMS")+1
.S ASUMV("E#","INDX")=ASUMX("IDX") D ^ASUMSTRD
.Q:$G(ASUMS("DEL"))]""
.S:ASUMS("SLC")=""!(ASUMS("SLC")=" ") ASUMS("SLC")="W"
.S ASUMV("E#","SLC")=$O(^ASUL(10,"B",ASUMS("SLC"),""))
.D NEWSLC^ASUV9IMW
.S ASUMV("STA")=ASUMS("E#","STA")
.I ASUMS("QTY","O/H")>0,ASUMS("VAL","O/H")>0 D
..S ASUMV("U/C")=$FN(ASUMS("VAL","O/H")/ASUMS("QTY","O/H"),"",2)
.E D
..S ASUMV("U/C")=ASUMS("LPP")
.S ASUMV("QTY","STAM")=ASUMS("QTY","O/H")
.I ASUMV("QTY","STAM")=""!(ASUMV("QTY","STAM")=" ") S ASUMV("QTY","STAM")=0
.D NEWIDX^ASUV9IMW
I ASUC("ITEMS") D
.S ASUMV("E#","SLC")=""
.F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,"B",ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")']"" D XREF^ASUV9IMW
.W !!,ASUC("ITEMS")," ITEMS SCHEDULED FOR PHYSICAL INVENTORY FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
.W !!,"NOW PRINT REPORT 37, 'PHYSICAL INVENTORY LIST' TO BEGIN THE INVENTORY",!!
E D
.W !!,"NO ITEMS FOUND FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),!
S DIR(0)="E" D ^DIR K DIR
;Q
K DIK,DA
EXIT ;
K ASUC("TR"),ASUMV,ASUMX,ASUMS,ASUR,ASUV
K DTOUT,DUOUT,DIC,X,Y,X2
K ASUL(3),ASUL(5),ASUL(6),ASUL(8),ASUL(9),ASUL(10)
Q
STA ;EP ;
D:'$D(DT) ^XBKVAR
D:$G(ASUK("DT","FM"))']"" DATE^ASUUDATE
D:$G(ASUL(1,"AR","AP"))']"" SETAREA^ASULARST
S ASUV("DT")=ASUK("DT","FM")
W !!
S DIC("A")="PROCESS INVENTORY FOR WHAT STATION? "
S DIC="9002039.02",DIC(0)="AMEZQ"
D ^DIC K DIC
I $D(DTOUT)!($D(DUOUT)) Q
I Y>0 D
.S ASUL(2,"STA","E#")=+Y
.S X=ASUL(1,"AR","AP"),X1=$P(Y,U,1) D STAT^ASULARST
.S ASUL(2,"STA","E#")=ASUL(1,"AR","AP")_"0"_ASUL(2,"STA","CD")
.W ?30,ASUL(2,"STA","NM")
E S DUOUT=1
W !
Q
ASUV0NT ; IHS/ASDST/WAR -INVTR INITIALIZE INVENTORY ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;;4.2T1;SUPPLY ACCOUNTING MGMT SYSTEM;;JAN 28, 2000
+3 ;This routine initializes the Physical Inventory Master (in ^ASUMV) for
+4 ;an account after verifying there is no current inventory active for
+5 ;that account. The Physical Inventory Master contains information from
+6 ;the Station Master (in ^ASUMS) concerning quantity and value at the
+7 ;beginning of an inventory. Once the Physical Inventory Master is
+8 ;initialized, a Physical Inventory can be conducted at the same time
+9 ;items are being issued from the account. It in effect 'freezes' the
+10 ;inventory information from the Station master for the items of that
+11 ;account.
+12 IF '$DATA(DT)
DO ^XBKVAR
+13 IF $GET(ASUK("DT","FM"))']""
DO DATE^ASUUDATE
+14 SET ASUV("DT")=ASUK("DT","FM")
+15 DO CLS^ASUUHDG
+16 IF $GET(ASUL(2,"STA","E#"))']""
DO STA
IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+17 SET DIC("A")="CREATE AN INVENTORY MASTER FILE FOR WHAT ACCOUNT? "
+18 SET DIC="9002039.09"
SET DIC(0)="AMEZQ"
+19 DO ^DIC
KILL DIC
+20 IF $DATA(DTOUT)!($DATA(DUOUT))
GOTO EXIT
+21 IF Y>0
Begin DoDot:1
+22 SET ASUMV("ACC")=$PIECE(Y,U)
SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
+23 DO ACC^ASULDIRF(ASUMV("ACC"))
End DoDot:1
+24 IF '$TEST
GOTO EXIT
+25 IF ASUMV("E#","ASA")=""
GOTO EXIT
+26 ;;CHG 3/13/95 CSC
SET ASUMS("E#","STA")=$ORDER(^ASUMS("B",ASUL(2,"STA","E#"),""))
+27 IF ASUMS("E#","STA")'?1N.N
QUIT
+28 IF $DATA(^ASUMV(ASUMV("E#","ASA"),0))
Begin DoDot:1
+29 DO ACCOUNT^ASUV9IMR
+30 IF ASUMV("MODE")=4
Begin DoDot:2
+31 DO REPACCT^ASUV9IMW
End DoDot:2
+32 IF '$TEST
Begin DoDot:2
+33 WRITE !!,"YOU HAVE REQUESTED AN PHYSICAL INVENTORY BE INITIALIZED, BUT AN"
+34 WRITE !,"INVENTORY IS ALREADY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
+35 WRITE !,"THE STATUS OF THAT INVENTORY IS ",$SELECT(ASUMV("MODE")=0:"INITIALIZED",ASUMV("MODE")=1:"INITIAL COUNT",ASUMV("MODE")=2:"RE-COUNT",ASUMV("MODE")=3:"RESEARCH",1:"COMPLETE")," MODE",!
+36 SET DIR("A")="DO YOU WANT TO CANCEL THE CURRENT INVENTORY AND START AGAIN"
+37 SET DIR(0)="Y"
SET DIR("B")="N"
+38 SET DIR("?")="Answer 'Y' to cancel the inventory or 'N' end the Inventory file Initialzation"
+39 DO ^DIR
KILL DIR
+40 IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+41 IF Y=0
SET DUOUT=1
QUIT
+42 WRITE !!,"WARNING! THIS WILL CAUSE ALL COUNTS TO BE LOST FOR THE CURRENT INVENTORY!",!!
+43 SET DIR("A")="ARE YOU SURE YOU WANT TO CANCEL THE CURRENT INVENTORY"
+44 SET DIR(0)="Y"
SET DIR("B")="N"
+45 DO ^DIR
KILL DIR
+46 IF $DATA(DUOUT)
QUIT
IF $DATA(DTOUT)
QUIT
+47 IF Y=0
SET DUOUT=1
QUIT
+48 DO REPACCT^ASUV9IMW
End DoDot:2
End DoDot:1
+49 IF '$TEST
Begin DoDot:1
+50 DO NEWACCT^ASUV9IMW
End DoDot:1
+51 IF $DATA(DUOUT)!($DATA(DTOUT))
GOTO EXIT
+52 WRITE !
+53 SET DIR("A")="ENTER A VOUCHER NUMBER FOR THE INVENTORY ADJUSTMENTS"
+54 SET DIR(0)="F^8:8^D VOU^ASUJVALF(.X,.DDSERROR)"
+55 SET DIR("?")="Voucher Number must be 8 numeric digits, not all zeors in format FYMMNNNN"
+56 DO ^DIR
KILL DIR
+57 IF $DATA(DUOUT)!($DATA(DTOUT))
DO DELACCT^ASUV9IMW
GOTO EXIT
+58 SET ASUR("VOU")=X
+59 SET ASUMV("VOU")=ASUR("VOU")
+60 SET ASUMV("MODE")=0
+61 DO ACCOUNT^ASUV9IMW
+62 ;D ASUV0NT1
ASUV0NT1 ;
+1 ;;CHG 3/13/95 CSC
SET ASUMS("E#","STA")=$ORDER(^ASUMS("B",ASUL(2,"STA","E#"),""))
+2 IF ASUMS("E#","STA")'?1N.N
QUIT
+3 SET (ASUC("ITEMS"),ASUMS("E#","IDX"))=0
+4 FOR
SET ASUMS("E#","IDX")=$ORDER(^ASUMS(ASUMS("E#","STA"),1,ASUMS("E#","IDX")))
IF ((ASUMS("E#","IDX")'?1N.N)!(ASUMS("E#","IDX")[999999))
QUIT
Begin DoDot:1
+5 SET (ASUMV("IDX"),ASUMX("E#","IDX"))=ASUMS("E#","IDX")
DO READ^ASUMXDIO
+6 ; ** LMH 6/15/00 QUIT IF INDEX MSTR. HAS BEEN DELETED **
+7 IF ASUMX("IDX")[999999!(ASUMX("IDX")="")
QUIT
+8 IF '$DATA(ASUMX("ACC"))
QUIT
+9 IF ASUMV("ACC")'=ASUMX("ACC")
QUIT
+10 SET ASUC("ITEMS")=ASUC("ITEMS")+1
+11 SET ASUMV("E#","INDX")=ASUMX("IDX")
DO ^ASUMSTRD
+12 IF $GET(ASUMS("DEL"))]""
QUIT
+13 IF ASUMS("SLC")=""!(ASUMS("SLC")=" ")
SET ASUMS("SLC")="W"
+14 SET ASUMV("E#","SLC")=$ORDER(^ASUL(10,"B",ASUMS("SLC"),""))
+15 DO NEWSLC^ASUV9IMW
+16 SET ASUMV("STA")=ASUMS("E#","STA")
+17 IF ASUMS("QTY","O/H")>0
IF ASUMS("VAL","O/H")>0
Begin DoDot:2
+18 SET ASUMV("U/C")=$FNUMBER(ASUMS("VAL","O/H")/ASUMS("QTY","O/H"),"",2)
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 SET ASUMV("U/C")=ASUMS("LPP")
End DoDot:2
+21 SET ASUMV("QTY","STAM")=ASUMS("QTY","O/H")
+22 IF ASUMV("QTY","STAM")=""!(ASUMV("QTY","STAM")=" ")
SET ASUMV("QTY","STAM")=0
+23 DO NEWIDX^ASUV9IMW
End DoDot:1
+24 IF ASUC("ITEMS")
Begin DoDot:1
+25 SET ASUMV("E#","SLC")=""
+26 FOR
SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,"B",ASUMV("E#","SLC")))
IF ASUMV("E#","SLC")']""
QUIT
DO XREF^ASUV9IMW
+27 WRITE !!,ASUC("ITEMS")," ITEMS SCHEDULED FOR PHYSICAL INVENTORY FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
+28 WRITE !!,"NOW PRINT REPORT 37, 'PHYSICAL INVENTORY LIST' TO BEGIN THE INVENTORY",!!
End DoDot:1
+29 IF '$TEST
Begin DoDot:1
+30 WRITE !!,"NO ITEMS FOUND FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),!
End DoDot:1
+31 SET DIR(0)="E"
DO ^DIR
KILL DIR
+32 ;Q
+33 KILL DIK,DA
EXIT ;
+1 KILL ASUC("TR"),ASUMV,ASUMX,ASUMS,ASUR,ASUV
+2 KILL DTOUT,DUOUT,DIC,X,Y,X2
+3 KILL ASUL(3),ASUL(5),ASUL(6),ASUL(8),ASUL(9),ASUL(10)
+4 QUIT
STA ;EP ;
+1 IF '$DATA(DT)
DO ^XBKVAR
+2 IF $GET(ASUK("DT","FM"))']""
DO DATE^ASUUDATE
+3 IF $GET(ASUL(1,"AR","AP"))']""
DO SETAREA^ASULARST
+4 SET ASUV("DT")=ASUK("DT","FM")
+5 WRITE !!
+6 SET DIC("A")="PROCESS INVENTORY FOR WHAT STATION? "
+7 SET DIC="9002039.02"
SET DIC(0)="AMEZQ"
+8 DO ^DIC
KILL DIC
+9 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+10 IF Y>0
Begin DoDot:1
+11 SET ASUL(2,"STA","E#")=+Y
+12 SET X=ASUL(1,"AR","AP")
SET X1=$PIECE(Y,U,1)
DO STAT^ASULARST
+13 SET ASUL(2,"STA","E#")=ASUL(1,"AR","AP")_"0"_ASUL(2,"STA","CD")
+14 WRITE ?30,ASUL(2,"STA","NM")
End DoDot:1
+15 IF '$TEST
SET DUOUT=1
+16 WRITE !
+17 QUIT
