ASUV0NT.m

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