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

ASUV2RN.m

Go to the documentation of this file. 
  1. ASUV2RN ; IHS/ITSC/LMH -ENTER RE-COUNTS ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine accepts Physical Inventory 'Re-Count' data input.
  1.  D:'$D(DT) ^XBKVAR
  1. ACCOUNT ;
  1.  F  D  I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .D ACCT
  1.  .I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .I ASUMV("E#","ASA")="" S ASUF=1 Q
  1.  .S DIR("A")="ENTER RE-COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
  1.  .S DIR("B")="Y"
  1.  .S DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select items or '^' to exit"
  1.  .S DIR(0)="SA^Y:Yes;N:No"
  1.  .D ^DIR K DIR
  1.  .I $D(DUOUT)!($D(DTOUT)) Q
  1.  .S ASUR("RSVP")=$E(Y)
  1.  .I ASUR("RSVP")="Y" D
  1.  ..D SLCLOOP
  1.  ..K ASUR("RSVP")
  1.  .E  D ASUV2RN3
  1.  K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX("E#")
  1.  K DTOUT,DUOUT,DIC,DIR,X,Y
  1.  Q
  1. SLCLOOP ;EP;
  1.  D CKIT
  1.  I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  S ASUMV("E#","SLC")=0
  1.  S ASUF("SLC")=1
  1.  F  S ASUMV("E#","SLC")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"))) Q:ASUMV("E#","SLC")'?1N.N  D  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  .D STORLOC^ASUV9IMR
  1.  .S ASUMV("E#","INDX")=0
  1.  .D CLS^ASUUHDG
  1.  .S ASUF("IDX")=0
  1.  .D IDXLOOP
  1.  D
  1.  .I ASUF("SLC") W !,"ALL RE-COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!! Q
  1.  .I 'ASUF("IDX") D
  1.  ..W !,"ALL RE-COUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -"
  1.  ..I $G(ASUV("SL NM"))']"" D STORLOC^ASUV9IMR
  1.  ..W $G(ASUV("SL NM"))," HAVE BEEN ENTERED",!!!
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1. IDXLOOP ;EP;
  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  Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  .D ASUV2RN2
  1.  Q
  1. LOOP ;EP;
  1.  S ASUMV("E#","ASA")=ASUL(2,"STA","E#")
  1.  F  S ASUMV("E#","ASA")=$O(^ASUMV(ASUMV("E#","ASA"))) Q:ASUMV("E#","ASA")'?1N.N  D SLCLOOP Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  Q
  1. ASUV2RN2 ;
  1.  I ASUMV("E#","INDX")'?1N.N G XIT2
  1.  D INDEX^ASUV9IMR
  1.  I ASUMV("IDX")["*" W !,"Master has been deleted",*7 Q
  1.  D READ^ASUMXDIO
  1.  I ASUMV("CNT-ENT")=2,ASUF("IDX")<2 G XIT2
  1.  I ASUMV("QTY","DIF")=0,$G(ASUF)<2 G XIT2
  1.  I 'ASUF("IDX") W !,"NOW PROCESSING ALL'",ASUMV("SLC"),"' STORAGE LOCATION ENTRIES",! S ASUF("IDX")=1
  1.  S ASUF("SLC")=0
  1.  W !!,"INDEX : ",ASUMX("IDX")
  1.  S ASUMS("STA")=$P(^ASUMS(ASUMV("STA"),0),U)
  1.  W ?15,ASUMX("DESC",1),?65,"STATION : ",ASUMS("STA")
  1.  K DIR
  1.  S DIR("B")=$S(ASUMV("CNT","2ND")>0:ASUMV("CNT","2ND"),1:"")
  1.  S DIR("A")="ENTER RE-COUNT QUANTITY"
  1.  S DIR(0)="NO^0:999999:0^K:X[""."" X" D ^DIR K DIR
  1.  I $D(DTOUT)!($D(DUOUT)) G XIT2
  1.  S ASUR("QTY")=X
  1.  I ASUR("QTY")="" G XIT2
  1.  S ASUMV("CNT","2ND")=ASUR("QTY")
  1.  S ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
  1.  S ASUMV("CNT-ENT")=2
  1.  D INDEX^ASUV9IMW
  1. XIT2 ;
  1.  Q
  1. ASUV2RN3 ;
  1.  S ASUR("ACC")=ASUMV("ACC")
  1.  F  D  I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .S DIC("A")="ENTER RE-COUNTS FOR WHAT STORAGE LOCATION CODE "
  1.  .S DIC="9002030.1",DIC(0)="AMEZ"
  1.  .D ^DIC K DIC
  1.  .I $D(DUOUT)!($D(DTOUT)) Q
  1.  .S ASUR("SLC")=$P(Y,U,2),ASUMV("E#","SLC")=+Y
  1.  .I ASUR("SLC")="" S ASUF=1 Q
  1.  .S ASUV("SL NM")=$P(Y(0),U,2)
  1.  .I '$D(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),0)) D  Q
  1.  ..W !,"NO ITEMS FOR STORAGE LOCATION ",ASUR("SLC")," IN ACCOUNT ",ASUL(9,"ACC","NM")," INVENTORY MASTER"
  1.  ..D PAUSE
  1.  .E  D
  1.  ..S DIR("A")="ENTER RE-COUNTS FOR ALL ITEMS? (Y/N) "
  1.  ..S DIR("B")="Y"
  1.  ..S DIR("?")="Enter 'Y' to enter re-counts for all items or 'N' to select item to enter re-counts on"
  1.  ..S DIR(0)="SA^Y:Yes;N:No"
  1.  ..D ^DIR K DIR
  1.  ..I $D(DUOUT)!($D(DTOUT)) Q
  1.  ..S ASUR("RSVP")=$E(Y)
  1.  ..I ASUR("RSVP")="Y" D
  1.  ...S ASUF("IDX")=0
  1.  ...D IDXLOOP
  1.  ...I ASUF("IDX")=0 W !,"ALL STORAGE LOCATION ",ASUV("SL NM")," '",ASUR("SLC"),"' RE-RECOUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM")
  1.  ..E  D
  1.  ...D RDINDX
  1.  .S ASUF=0
  1.  S ASUF=0
  1.  Q
  1. RDINDX ;
  1.  F  D  I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .W ! D ^ASUV9IDX
  1.  .I $D(DUOUT)!($D(DTOUT)) Q
  1.  .I ASUMX("E#","IDX")']"" S ASUF=1 Q
  1.  .S ASUMV("E#","INDX")="",ASUF("IDX")=2
  1.  .F ASUC("TR")=1:1 S ASUMV("E#","INDX")=$O(^ASUMV(ASUMV("E#","ASA"),1,ASUMV("E#","SLC"),1,"B",ASUMX("E#","IDX"),ASUMV("E#","INDX"))) D  Q:ASUMV("E#","INDX")=""
  1.  ..I ASUMV("E#","INDX")]"" D
  1.  ...D ASUV2RN2
  1.  ..E  I ASUC("TR")=1 D
  1.  ...W !,"INDEX NOT IN INVENTORY MASTER FOR ACCOUNT ",ASUMV("ACC")," ",ASUL(9,"ACC","NM"),!,"STORAGE LOCATION ",ASUR("SLC")
  1.  ...D PAUSE
  1.  .S ASUF=0
  1.  S ASUF=0
  1.  Q
  1. PAUSE ;
  1.  S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1. ASUV2RN0 ;EP ;CHECK RE-COUNTS;
  1.  D CKIT G:($G(ASUF)>0) EXIT
  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  I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
  1.  .D STORLOC^ASUV9IMR
  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  I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
  1.  ..D INDEX^ASUV9IMR
  1.  ..Q:ASUMV("IDX")["*"  ;MASTER HAS BEEN DELETED
  1.  ..I ASUMV("QTY","DIF")=0 Q
  1.  ..I ASUMV("CNT-ENT")=2 Q
  1.  ..S ASUF=1
  1.  I ASUF=1 D
  1.  .S ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN RE-COUNTED -RE-COUNT NOT MARKED AS COMPLETE"""
  1.  .D V^ASUUPLOG
  1.  G EXIT
  1. FLAGIT3 ;EP;
  1.  S ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED -RE-COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUL(9,"ACC","NM"))_" IS NOW IN RESEARCH MODE"""
  1.  D V^ASUUPLOG
  1.  S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=3
  1. EXIT ;
  1.  Q
  1. ACCT ;EP;ACCOUNT
  1.  I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G EXIT
  1.  D CLS^ASUUHDG
  1.  S DIC("A")="ENTER RE-COUNTS FOR WHAT ACCOUNT? "
  1.  S DIC="9002039.09",DIC(0)="AMEZQ"
  1.  D ^DIC K DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  Q:'$D(Y)
  1.  I Y>0 D
  1.  .S ASUF=0
  1.  .S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
  1.  .D ACC^ASULDIRF(ASUMV("ACC"))
  1.  E  D  Q
  1.  .S ASUMV("E#","ASA")=ASUL(2,"STA","E#") S ASUF=1
  1.  I $D(^ASUMV(ASUMV("E#","ASA"),0)) D
  1.  .D ACCOUNT^ASUV9IMR,CKIT
  1.  E  D
  1.  .S ASURX="W !,""NO INVENTORY ACTIVE FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUMV("E#","ACC","NM"))_"""",ASUF=1
  1.  .D V^ASUUPLOG
  1.  G EXIT
  1. CKIT ;EP;
  1.  I ASUMV("MODE")=2 S ASUF=0 Q
  1.  I ASUMV("MODE")=0 S ASUV("MSG")="INVENTORY NOT BEGUN " D MESSAGE Q
  1.  I ASUMV("MODE")=1 S ASUV("MSG")="FIRST COUNTS NOT COMPLETED " D MESSAGE Q
  1.  S ASUV("MSG")="RE-COUNTS COMPLETED " D MESSAGE
  1.  I ASUF=2 S ASUF=1 Q
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:ASUK("PTR-Q")
  1.  S DIR(0)="Y",DIR("A")="DO YOU WANT TO RE-PRINT THE RE-COUNT LISTING? ",DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST" D ^DIR K DIR
  1.  I Y S ASUF=0,ASUF("RPRN")=1
  1.  Q
  1. MESSAGE ;
  1.  S ASUV("MSG",1)=$G(ASUV("MSG",1))
  1.  S ASURX="W !,"""_ASUV("MSG",1)_""",!,"""_ASUV("MSG")_"FOR ACCOUNT '"_ASUMV("ACC")_"' -"_$G(ASUL(9,"ACC","NM"))_" INVENTORY"""
  1.  S ASURX=ASURX_",!,""WHICH IS IN "_$S(ASUMV("MODE")=0:"INITIALIZED",ASUMV("MODE")=3:"RESEARCH",ASUMV("MODE")=4:"COMPLETED",1:"FIRST COUNT")_" MODE"""
  1.  I ASUV("MSG",1)="" D
  1.  .S ASUF=2
  1.  E  D
  1.  .S ASUF=1
  1.  D V^ASUUPLOG
  1.  K ASUV("MSG")
  1.  Q