Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ASUV2RL

ASUV2RL.m

Go to the documentation of this file.
  1. ASUV2RL ; IHS/ITSC/LMH -RPT RE-COUNT INVENTORY LIST ;
  1. ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1. ;This routine creates the Physical Inventory Re-count List.
  1. D:'$D(DT) ^XBKVAR S %H=$H D YX^%DTC S ASUK("RUN","DT")=$P(Y,"@") K X,Y,%H
  1. D:'$D(IO(0)) HOME^%ZIS
  1. D CLS^ASUUHDG
  1. I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G EXIT
  1. S DIC("A")="PRINT RPT 37A 'INVENTORY RE-COUNT LIST' FOR WHAT ACCOUNT "
  1. S DIC="9002039.09",DIC(0)="AMEZQ"
  1. D ^DIC K DIC
  1. I $D(DTOUT)!($D(DUOUT)) G EXIT
  1. Q:'$D(Y) Q:Y=""
  1. I Y>0 D
  1. .S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
  1. .D ACC^ASULDIRF(ASUMV("ACC"))
  1. E G EXIT
  1. G:ASUMV("E#","ASA")="" EXIT
  1. I $D(^ASUMV(ASUMV("E#","ASA"),0)) D
  1. .D ACCOUNT^ASUV9IMR
  1. E D Q
  1. .W !!,"NO INVENTORY ACTIVE FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM")
  1. .S DIR(0)="E" D ^DIR K DIR
  1. S ASUV("ASA")=ASUMV("E#","ASA")
  1. S ASUF=$G(ASUF)
  1. I ASUF=2 D
  1. .S ASUF=0,ASUMV("MODE")=2
  1. E D
  1. .S ASUV("MSG",1)="YOU HAVE REQUESTED A RE-COUNT LIST BUT "
  1. .D ASUV1PN0^ASUV1PN
  1. G:ASUF EXIT
  1. D ASUV2RL0
  1. I '$D(IO) D HOME^%ZIS
  1. I '$D(DUZ(2)) W !,"Report must be run from Kernel option" Q
  1. I '$D(ASUL(1,"AR","AP")) D SETAREA^ASULARST
  1. S ZTRTN="PSER^ASUV2RL",ZTDESC="SAMS RE-COUNT INVENTORY LIST" D O^ASUUZIS
  1. I POP S IOP=$I D ^%ZIS Q
  1. I ASUK("PTR-Q") K IOP,POP,ZTDESC,ZTRTN,ZTSK,ASUK(ASUK("PTR")),ASUK("PTR"),ASUK("PTR-Q") G EXIT
  1. PSER ;EP;FOR TASKMAN QUEUE OF PRINT
  1. D U^ASUUZIS
  1. S (ASUC("PG"),ASUC("LN"))=0
  1. D ACCOUNT^ASUV9IMR
  1. S ASUMV("E#","SLC")=""
  1. F ASUC(1)=0:1 S ASUMV("E#","SLC")=$O(^ASUV("RL",ASUMV("E#","ASA"),ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D
  1. .D STORLOC^ASUV9IMR
  1. .D:ASUC("LN")<1 HEADING
  1. .S ASUMV("E#","INDX")=""
  1. .F S ASUMV("E#","INDX")=$O(^ASUV("RL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX"))) Q:ASUMV("E#","INDX")'?1N.N D
  1. ..D INDEX^ASUV9IMR
  1. ..Q:ASUMV("IDX")["*" ;MASTER HAS BEEN DELETED
  1. ..D:ASUC("LN")>55 HEADING
  1. ..D READ^ASUMXDIO
  1. ..S ASUMS("E#","IDX")=$O(^ASUMS(ASUL(2,"STA","E#"),1,"B",ASUMX("E#","IDX"),""))
  1. ..S ASUMS("ORD#")=$P(^ASUMS(ASUL(2,"STA","E#"),1,ASUMS("E#","IDX"),0),U,3)
  1. ..S ASUV("ORD#")=$S(ASUMS("ORD#")'=" ":ASUMS("ORD#"),1:ASUMX("NSN"))
  1. ..W !?1,ASUMV("SLC"),?8,$E(ASUMX("IDX"),1,5),".",$E(ASUMX("IDX"),6,6),?20,ASUMX("DESC",1),?51,ASUMX("AR U/I")
  1. ..W ?55,$J(ASUMV("QTY","STAM"),7),?63,$J(ASUMV("CNT","1ST"),7)
  1. ..W !?2,ASUV("ORD#"),?20,ASUMX("DESC",2)
  1. ..D SEPERATE
  1. ..S ASUC("LN")=ASUC("LN")+3
  1. .D:ASUC("LN")>7 FOOTING
  1. D:ASUC("LN")>7 FOOTING
  1. I ASUC("1")=0 D HEADING W !,"NO ITEMS TO BE RECOUNTED -ALL MATCHED FIRST COUNT",! D SEPERATE,FOOTING
  1. I $G(ASUK(ASUK("PTR"),"S")) D C^ASUUZIS
  1. I '$G(ASUF("RPRN")) U IO(0) D FLAGIT2^ASUV1PN
  1. EXIT ;
  1. K ASUC,ASUR,ASUF,ASUMS,ASUMV,ASUV,ASUMX
  1. K DTOUT,DUOUT,ZTDESC,ZTRTN,X,Y,X1
  1. D:$D(ASUK("PTR")) C^ASUUZIS
  1. Q
  1. HEADING ;
  1. D CLS^ASUUHDG S ASUC("PG")=ASUC("PG")+1,ASUC("LN")=7
  1. W "REPORT NO. 37A INVENTORY RECOUNT LISTING DATE : ",ASUK("RUN","DT"),?70," PAGE : ",ASUC("PG")
  1. W !,"AREA: ",ASUL(1,"AR","E#")," ",ASUL(1,"AR","NM")
  1. W !,"STAT: ",ASUL(2,"STA","CD")," ",ASUL(2,"STA","NM"),?35,"ACCOUNT : ",ASUL(9,"ACC","NM"),?60,"SLC : ",$G(ASUMV("SL NM"))
  1. W !!,"SLC INDEX",?52,"U RECORD FIRST RECOUNT"
  1. W !," ORD/NSN NUMBER DESCRIPTION",?53,"I BALANCE COUNT QUANTITY"
  1. D SEPERATE
  1. Q
  1. SEPERATE ;
  1. W !,"_______________________________________________________________________________"
  1. Q
  1. FOOTING ;
  1. D:ASUC("LN")>56 HEADING
  1. W !!?5,"RECOUNTERS:",?50,"DATE:"
  1. W !?25,"SIGNATURE/TITLE"
  1. W !!?50,"DATE:"
  1. W !?25,"SIGNATURE/TITLE"
  1. S ASUC("LN")=0
  1. Q
  1. ASUV2RL0 ;SORT
  1. K ^ASUV("RL")
  1. S ASUMV("E#","SLC")=0
  1. F S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N D
  1. .S ASUMV("E#","INDX")=0
  1. .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
  1. ..D ^ASUV9IMR
  1. ..Q:ASUMV("STA")']""
  1. ..Q:ASUMV("QTY","DIF")=0
  1. ..S ^ASUV("RL",ASUMV("E#","ASA"),ASUMV("E#","SLC"),ASUMV("E#","INDX"))=""
  1. Q