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

ASUV1PN.m

Go to the documentation of this file. 
  1. ASUV1PN ; IHS/ITSC/LMH -ENTER 1ST COUNTS ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine accepts Physical Inventory 'First Count' data input.
  1.  D:'$D(DT) ^XBKVAR
  1. ACCOUNT ;
  1.  F  D  Q:$D(DUOUT)  Q:$D(DTOUT)  Q:$G(ASUF)>0
  1.  .D ACCT
  1.  .I $D(DUOUT)!($D(DTOUT)) Q
  1.  .Q:$G(ASUF)>0
  1.  .I ASUMV("E#","ASA")="" S ASUF=1 Q
  1.  .S DIR("A")="ENTER COUNTS FOR ALL STORAGE LOCATIONS? (Y/N) "
  1.  .S DIR("B")="Y"
  1.  .S DIR("?")="Enter 'Y' to enter 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
  1.  ..D ASUV1PN3
  1.  K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
  1.  K DTOUT,DUOUT,DIC,DIR,X,Y
  1.  Q
  1. ASUV1PN0 ;EP ;
  1.  D CKIT
  1.  G:($G(ASUF)>0)!($D(DTOUT))!($D(DUOUT)) XIT1
  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)]"" Q
  1.  ..D INDEX^ASUV9IMR
  1.  ..Q:ASUMV("IDX")["*"  ;MASTER HAS BEEN DELETED
  1.  ..I ASUMV("CNT-ENT")=1 Q
  1.  ..S ASUF=1
  1.  I ASUF=1 D
  1.  .S ASURX="W !,""AT LEAST ONE ITEM HAS NOT BEEN COUNTED -FIRST COUNT NOT MARKED AS COMPLETE"""
  1.  .D V^ASUUPLOG
  1.  G XIT1
  1. FLAGIT1 ;EP;
  1.  S ASURX="W !,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN FIRST COUNT MODE"""
  1.  D V^ASUUPLOG
  1.  S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=1
  1.  G XIT1
  1. FLAGIT2 ;EP;
  1.  S ASURX="W !,""ALL ITEMS HAVE BEEN COUNTED ONCE -FIRST COUNT MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT '"_ASUMV("ACC")_"' -"_ASUL(9,"ACC","NM")_" IS NOW IN RE-COUNT MODE"""
  1.  D V^ASUUPLOG
  1.  S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=2
  1. XIT1 ;
  1.  Q
  1. ACCT ;EP;ACCOUNT
  1.  D CLS^ASUUHDG
  1.  S DIC("A")="ENTER 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")_"' -"_ASUL(9,"ACC","NM")_"""",ASUF=1
  1.  .D V^ASUUPLOG
  1.  G XIT1
  1. CKIT ;EP;
  1.  I ASUMV("MODE")=1 S ASUF=0 Q
  1.  I ASUMV("MODE")=0 S ASUV("MSG")="INITIAL INVENTORY LIST HAS NOT YET BEEN CREATED " D MESSAGE Q
  1.  S ASUV("MSG")="FIRST COUNTS ARE ALREADY COMPLETED " D MESSAGE
  1.  D REPRINT
  1.  Q
  1. CKINIT ;EP;
  1.  I ASUMV("MODE")=0 S ASUF=0 Q
  1.  S ASUV("MSG")="INVENTORY HAS ALREADY BEGUN " D MESSAGE
  1. REPRINT ;
  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"
  1.  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")_"' -"_ASUL(9,"ACC","NM")_" INVENTORY"""
  1.  S ASURX=ASURX_",!,""WHICH IS IN "_$S(ASUMV("MODE")=1:"FIRST COUNT",ASUMV("MODE")=2:"RECOUNT",ASUMV("MODE")=3:"RESEARCH",1:"COMPLETED")_" MODE"""
  1.  I ASUV("MSG",1)="" D
  1.  .S ASUF=2
  1.  E  D
  1.  .S ASUF=1
  1.  K ASUV("MSG")
  1.  D V^ASUUPLOG
  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.  .D CLS^ASUUHDG
  1.  .S ASUF("IDX")=0
  1.  .D IDXLOOP
  1.  D
  1.  .I ASUF("SLC") W !,"ALL COUNTS FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM")," HAVE BEEN ENTERED",!!! Q
  1.  .I 'ASUF("IDX") W !,"ALL RECOUNTS FOR STORAGE LOCATION '",ASUMV("SLC"),"' -",ASUMV("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 ASUV1PN2
  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. ASUV1PN2 ;
  1.  I ASUMV("E#","INDX")'?1N.N G XIT2
  1.  D INDEX^ASUV9IMR
  1.  Q:ASUMV("IDX")["*"  ;MASTER HAS BEEN DELETED
  1.  D READ^ASUMXDIO
  1.  I ASUMV("CNT-ENT")=1,ASUF("IDX")<2 G XIT2
  1.  D:$G(ASUMV("SLC"))']"" STORLOC^ASUV9IMR
  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.  S DIR("B")=$S(ASUMV("CNT","1ST")>0:ASUMV("CNT","1ST"),1:"")
  1.  S DIR("A")="ENTER INVENTORY QUANTITY COUNT"
  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","1ST")=ASUR("QTY")
  1.  S ASUMV("QTY","DIF")=ASUR("QTY")-ASUMV("QTY","STAM")
  1.  S ASUMV("CNT-ENT")=1
  1.  D INDEX^ASUV9IMW
  1. XIT2 ;
  1.  Q
  1. ASUV1PN3 ;
  1.  S ASUR("ACC")=ASUMV("ACC")
  1.  F  D  I $D(DUOUT)!($D(DTOUT))!$G(ASUF)]"" Q
  1.  .S DIC("A")="ENTER 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 ",ASUV("SL NM")," '",ASUR("SLC"),"' IN ACCOUNT ",ASUL(9,"ACC","NM")," INVENTORY MASTER"
  1.  ..D PAUSE
  1.  .E  D
  1.  ..S DIR("A")="ENTER COUNTS FOR ALL ITEMS? (Y/N) "
  1.  ..S DIR("B")="Y"
  1.  ..S DIR("?")="Enter 'Y' to enter counts for all items or 'N' to select item to enter 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  Q
  1.  ...S ASUF("IDX")=0
  1.  ...D IDXLOOP
  1.  ...I ASUF("IDX")=0 W !,"ALL ",ASUV("SL NM")," '",ASUR("SLC"),"' ITEM COUNTS HAVE BEEN ENTERED FOR ACCOUNT ",ASUL(9,"ACC","NM") D PAUSE
  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)]"" 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 ASUV1PN2
  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