ASUV1PL.m

ASUV1PL ; IHS/ITSC/LMH -RPT 37 PHYSICAL INVENTORY LIST ; 

 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 ;This routine creates report 37 - Physical Inventory List

 D:'$D(DT) ^XBKVAR S %H=$H D YX^%DTC S ASUK("RUN","DT")=$P(Y,"@") K X,Y,%H

 D:'$D(IO(0)) HOME^%ZIS

 D CLS^ASUUHDG

 I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G XIT1

 S DIC("A")="PRINT RPT 37 'PHYSICAL INVENTORY LIST' FOR WHAT ACCOUNT? "

 S DIC="9002039.09",DIC(0)="AMEZQ"

 D ^DIC K DIC

 I $D(DTOUT)!($D(DUOUT)) G XIT1

 K DIR

 Q:'$D(Y)  Q:Y=""

 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 XIT1

 G:ASUMV("E#","ASA")="" XIT1

 I $D(^ASUMV(ASUMV("E#","ASA"),0)) D

 .D ACCOUNT^ASUV9IMR

 E  D  Q

 .W !!,"NO INVENTORY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")

 .S DIR(0)="E" D ^DIR K DIR

 S ASUV("ASA")=ASUMV("E#","ASA")

 S ASUF=$G(ASUF)

 I ASUF=2 D

 .S ASUF=0,ASUMV("MODE")=1

 E  D

 .S ASUV("MSG",1)="YOU HAVE REQUESTED AN INVENTORY LIST BUT "

 .D CKINIT^ASUV1PN K ASURX

 G:ASUF XIT1

 D ASUV1PL0

 I '$D(IO) D HOME^%ZIS

 I '$D(DUZ(2)) W !,"Report must be run from Kernel option" D PAZ^ASUURHDR Q

 S ZTRTN="PSER^ASUV1PL",ZTDESC="SAMS PHYSICAL INVENTORY LIST" D O^ASUUZIS

 I POP S IOP=$I D ^%ZIS Q

 I ASUK(ASUK("PTR"),"Q") K IOP,POP,ZTDESC,ZTRTN,ZTSK,ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q") G XIT1

PSER ;EP;FOR TASKMAN QUEUE OF PRINT

 D U^ASUUZIS

 S (ASUC("PG"),ASUC("LN"))=0

 D ACCOUNT^ASUV9IMR

 S ASUMV("E#","SLC")=""

 F  S ASUMV("E#","SLC")=$O(^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N  D

 .D STORLOC^ASUV9IMR

 .D:ASUC("LN")<1 HEADING

 .S ASUMV("E#","INDX")=""

 .F  S ASUMV("E#","INDX")=$O(^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N  D

 ..D INDEX^ASUV9IMR

 ..Q:ASUMV("IDX")["*"  ;MASTER HAS BEEN DELETED

 ..D:ASUC("LN")>55 HEADING

 ..D READ^ASUMXDIO

 ..S ASUMS("E#","IDX")=$O(^ASUMS(ASUL(2,"STA","E#"),1,"B",ASUMX("E#","IDX"),""))

 ..S ASUMS("ORD#")=$P(^ASUMS(ASUL(2,"STA","E#"),1,ASUMS("E#","IDX"),0),U,3)

 ..S ASUV("ORD#")=$S(ASUMS("ORD#")'=" ":ASUMS("ORD#"),1:ASUMX("NSN"))

 ..W !?1,ASUMV("SLC"),?8,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6),?20,ASUMX("DESC",1),?51,ASUMX("AR U/I")

 ..W !?2,ASUV("ORD#"),?20,ASUMX("DESC",2)

 ..D SEPERATE

 ..S ASUC("LN")=ASUC("LN")+3

 .D:ASUC("LN")>7 FOOTING

 D:ASUC("LN")>7 FOOTING

 I $G(ASUK(ASUK("PTR"),"S")) D C^ASUUZIS

 I '$G(ASUF("RPRN")) U IO(0) D FLAGIT1^ASUV1PN

XIT1 ;

 K ASUC,ASUR,ASUF,ASUMS,ASUMV,ASUV,ASUMX

 K DTOUT,DUOUT,ZTDESC,ZTRTN,X,Y,X1

 D:$D(ASUK("PTR")) C^ASUUZIS

 Q

HEADING ;

 D CLS^ASUUHDG S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=7

 W "REPORT 37  PHYSICAL INVENTORY LISTING   DATE : ",ASUK("RUN","DT"),?70," PAGE : ",ASUC("PG")

 W !,"AREA: ",ASUL(1,"AR","E#")," ",ASUL(1,"AR","NM")

 W !,"STAT: ",ASUL(2,"STA","CD")," ",ASUL(2,"STA","NM"),?35,"ACCOUNT : ",ASUL(9,"ACC","NM"),?60,"SLC : ",ASUMV("SL NM")

 W !!,"SLC      INDEX",?51,"U   INVENTORY"

 W !," ORD/NSN NUMBER     DESCRIPTION",?53,"I     COUNT"

 D SEPERATE

 Q

SEPERATE ;

 W !,"_______________________________________________________________________________"

 Q

FOOTING ;

 D:ASUC("LN")>55 HEADING

 W !!?5,"INVENTORY RECORDER:",?50,"DATE:"

 W !?25,"SIGNATURE/TITLE"

 W !!?5,"INVENTORY COUNTER:",?50,"DATE:"

 W !?25,"SIGNATURE/TITLE"

 S ASUC("LN")=0

 Q

ASUV1PL0 ;

 K ^ASUV("IL")

 S ASUMV("E#","SLC")=""

 F  S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N  D

 .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

 ..D ^ASUV9IMR

 ..Q:ASUMV("STA")']""

 ..S ^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX"))=""

 Q

ASUV1PL   ; IHS/ITSC/LMH -RPT 37 PHYSICAL INVENTORY LIST ; 

 +1       ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000

 +2       ;This routine creates report 37 - Physical Inventory List

 +3        IF '$DATA(DT)

               DO ^XBKVAR

           SET %H=$HOROLOG

           DO YX^%DTC

           SET ASUK("RUN","DT")=$PIECE(Y,"@")

           KILL X,Y,%H

 +4        IF '$DATA(IO(0))

               DO HOME^%ZIS

 +5        DO CLS^ASUUHDG

 +6        IF $GET(ASUL(2,"STA","E#"))']""

               DO STA^ASUV0NT

               IF $DATA(DTOUT)!($DATA(DUOUT))

                   GOTO XIT1

 +7        SET DIC("A")="PRINT RPT 37 'PHYSICAL INVENTORY LIST' FOR WHAT ACCOUNT? "

 +8        SET DIC="9002039.09"

           SET DIC(0)="AMEZQ"

 +9        DO ^DIC

           KILL DIC

 +10       IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO XIT1

 +11       KILL DIR

 +12       IF '$DATA(Y)

               QUIT 

           IF Y=""

               QUIT 

 +13       IF Y>0

               Begin DoDot:1

 +14               SET ASUMV("ACC")=$PIECE(Y,U)

                   SET ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")

 +15               DO ACC^ASULDIRF(ASUMV("ACC"))

               End DoDot:1

 +16      IF '$TEST

               GOTO XIT1

 +17       IF ASUMV("E#","ASA")=""

               GOTO XIT1

 +18       IF $DATA(^ASUMV(ASUMV("E#","ASA"),0))

               Begin DoDot:1

 +19               DO ACCOUNT^ASUV9IMR

               End DoDot:1

 +20      IF '$TEST

               Begin DoDot:1

 +21               WRITE !!,"NO INVENTORY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")

 +22               SET DIR(0)="E"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

               QUIT 

 +23       SET ASUV("ASA")=ASUMV("E#","ASA")

 +24       SET ASUF=$GET(ASUF)

 +25       IF ASUF=2

               Begin DoDot:1

 +26               SET ASUF=0

                   SET ASUMV("MODE")=1

               End DoDot:1

 +27      IF '$TEST

               Begin DoDot:1

 +28               SET ASUV("MSG",1)="YOU HAVE REQUESTED AN INVENTORY LIST BUT "

 +29               DO CKINIT^ASUV1PN

                   KILL ASURX

               End DoDot:1

 +30       IF ASUF

               GOTO XIT1

 +31       DO ASUV1PL0

 +32       IF '$DATA(IO)

               DO HOME^%ZIS

 +33       IF '$DATA(DUZ(2))

               WRITE !,"Report must be run from Kernel option"

               DO PAZ^ASUURHDR

               QUIT 

 +34       SET ZTRTN="PSER^ASUV1PL"

           SET ZTDESC="SAMS PHYSICAL INVENTORY LIST"

           DO O^ASUUZIS

 +35       IF POP

               SET IOP=$IO

               DO ^%ZIS

               QUIT 

 +36       IF ASUK(ASUK("PTR"),"Q")

               KILL IOP,POP,ZTDESC,ZTRTN,ZTSK,ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q")

               GOTO XIT1

PSER      ;EP;FOR TASKMAN QUEUE OF PRINT

 +1        DO U^ASUUZIS

 +2        SET (ASUC("PG"),ASUC("LN"))=0

 +3        DO ACCOUNT^ASUV9IMR

 +4        SET ASUMV("E#","SLC")=""

 +5        FOR 

               SET ASUMV("E#","SLC")=$ORDER(^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC")))

               IF ASUMV("E#","SLC")'?1N.N

                   QUIT 

               Begin DoDot:1

 +6                DO STORLOC^ASUV9IMR

 +7                IF ASUC("LN")<1

                       DO HEADING

 +8                SET ASUMV("E#","INDX")=""

 +9                FOR 

                       SET ASUMV("E#","INDX")=$ORDER(^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX")))

                       IF ASUMV("E#","INDX")'?1N.N

                           QUIT 

                       Begin DoDot:2

 +10                       DO INDEX^ASUV9IMR

 +11      ;MASTER HAS BEEN DELETED

                           IF ASUMV("IDX")["*"

                               QUIT 

 +12                       IF ASUC("LN")>55

                               DO HEADING

 +13                       DO READ^ASUMXDIO

 +14                       SET ASUMS("E#","IDX")=$ORDER(^ASUMS(ASUL(2,"STA","E#"),1,"B",ASUMX("E#","IDX"),""))

 +15                       SET ASUMS("ORD#")=$PIECE(^ASUMS(ASUL(2,"STA","E#"),1,ASUMS("E#","IDX"),0),U,3)

 +16                       SET ASUV("ORD#")=$SELECT(ASUMS("ORD#")'=" ":ASUMS("ORD#"),1:ASUMX("NSN"))

 +17                       WRITE !?1,ASUMV("SLC"),?8,$EXTRACT(ASUMX("IDX"),1,5),".",$EXTRACT(ASUMX("IDX"),6,6),?20,ASUMX("DESC",1),?51,ASUMX("AR U/I")

 +18                       WRITE !?2,ASUV("ORD#"),?20,ASUMX("DESC",2)

 +19                       DO SEPERATE

 +20                       SET ASUC("LN")=ASUC("LN")+3

                       End DoDot:2

 +21               IF ASUC("LN")>7

                       DO FOOTING

               End DoDot:1

 +22       IF ASUC("LN")>7

               DO FOOTING

 +23       IF $GET(ASUK(ASUK("PTR"),"S"))

               DO C^ASUUZIS

 +24       IF '$GET(ASUF("RPRN"))

               USE IO(0)

               DO FLAGIT1^ASUV1PN

XIT1      ;

 +1        KILL ASUC,ASUR,ASUF,ASUMS,ASUMV,ASUV,ASUMX

 +2        KILL DTOUT,DUOUT,ZTDESC,ZTRTN,X,Y,X1

 +3        IF $DATA(ASUK("PTR"))

               DO C^ASUUZIS

 +4        QUIT 

HEADING   ;

 +1        DO CLS^ASUUHDG

           SET ASUC("PG")=ASUC("PG")+1

           SET ASUC("LN")=7

 +2        WRITE "REPORT 37  PHYSICAL INVENTORY LISTING   DATE : ",ASUK("RUN","DT"),?70," PAGE : ",ASUC("PG")

 +3        WRITE !,"AREA: ",ASUL(1,"AR","E#")," ",ASUL(1,"AR","NM")

 +4        WRITE !,"STAT: ",ASUL(2,"STA","CD")," ",ASUL(2,"STA","NM"),?35,"ACCOUNT : ",ASUL(9,"ACC","NM"),?60,"SLC : ",ASUMV("SL NM")

 +5        WRITE !!,"SLC      INDEX",?51,"U   INVENTORY"

 +6        WRITE !," ORD/NSN NUMBER     DESCRIPTION",?53,"I     COUNT"

 +7        DO SEPERATE

 +8        QUIT 

SEPERATE  ;

 +1        WRITE !,"_______________________________________________________________________________"

 +2        QUIT 

FOOTING   ;

 +1        IF ASUC("LN")>55

               DO HEADING

 +2        WRITE !!?5,"INVENTORY RECORDER:",?50,"DATE:"

 +3        WRITE !?25,"SIGNATURE/TITLE"

 +4        WRITE !!?5,"INVENTORY COUNTER:",?50,"DATE:"

 +5        WRITE !?25,"SIGNATURE/TITLE"

 +6        SET ASUC("LN")=0

 +7        QUIT 

ASUV1PL0  ;

 +1        KILL ^ASUV("IL")

 +2        SET ASUMV("E#","SLC")=""

 +3        FOR 

               SET ASUMV("E#","SLC")=$ORDER(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC")))

               IF ASUMV("E#","SLC")'?1N.N

                   QUIT 

               Begin DoDot:1

 +4                SET ASUMV("E#","INDX")=0

 +5                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

 +6                        DO ^ASUV9IMR

 +7                        IF ASUMV("STA")']""

                               QUIT 

 +8                        SET ^ASUV("IL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX"))=""

                       End DoDot:2

               End DoDot:1

 +9        QUIT