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

ASUV3AN.m

Go to the documentation of this file. 
  1. ASUV3AN ; IHS/ITSC/LMH -ENTER ADJUSTMENTS ; 
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine accepts Physical Inventory 'Adjustments' data input.
  1.  D:'$D(DT) ^XBKVAR
  1.  F  D  I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .D ACCOUNT
  1.  .I $D(DUOUT)!($D(DTOUT))!($G(ASUF)>0) Q
  1.  .I ASUMV("E#","ASA")="" S ASUF=1 Q
  1.  .S ASUF("IDX")=1
  1.  .S DIR("A")="ENTER RESEARCH ADJUSTMENT 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 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 IXLOOP
  1.  ..K ASUR("RSVP")
  1.  .E  D
  1.  ..K ^ASUV("AX",ASUMV("E#","ASA"))
  1.  ..D ASUV3AN4,ASUV3AN1 S ASUF=0
  1.  .I ASUF("IDX") D
  1.  ..W !!!,"ALL RESEARCH ADJUSTMENT QUANTITIES ENTERED FOR ACCOUNT '",ASUMV("ACC"),"' -",ASUL(9,"ACC","NM"),!
  1.  ..S DIR(0)="E" D ^DIR K DIR
  1.  K ASUC("TR"),ASUR,ASUSAV,ASUF,ASUMV,ASUV,ASUMX
  1.  K DTOUT,DUOUT,DIC,DIR,X,Y
  1.  Q
  1. ASUV3AN0 ;EP ; CHECK
  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)>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 RESEARCHED -RESEARCH NOT MARKED AS COMPLETE"""
  1.  .D V^ASUUPLOG
  1.  G XIT1
  1. FLAGIT4 ;EP ;SET FLAGS
  1.  S ASURX="W !,""ALL ITEMS HAVE BEEN RESEARCHED -RESEARCH MARKED AS COMPLETE"",!,""INVENTORY FOR ACCOUNT "_ASUMV("ACC")_" "
  1.  D:$G(ASUL(9,"ACC","NM"))="" ACC^ASULDIRF(ASUMV("ACC"))
  1.  S ASURX=ASURX_ASUL(9,"ACC","NM")_" IS NOW IN COMPLETED MODE"""
  1.  D V^ASUUPLOG
  1.  S $P(^ASUMV(ASUMV("E#","ASA"),0),U,4)=4
  1. XIT1 ;
  1.  Q
  1. ACCOUNT ;
  1.  I $G(ASUL(2,"STA","E#"))']"" D STA^ASUV0NT I $D(DTOUT)!($D(DUOUT)) G XIT1
  1.  D CLS^ASUUHDG
  1.  S DIC("A")="ENTER RESEARCH ADJUSTED QUANTITIES FOR WHAT ACCOUNT? "
  1.  S DIC="9002039.09",DIC(0)="AMEZQ"
  1.  D ^DIC K DIC
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  I '$D(Y) S ASUF=1 Q
  1.  I Y>0 D
  1.  .S ASUMV("ACC")=$P(Y,U),ASUMV("E#","ASA")=ASUL(2,"STA","E#")_ASUMV("ACC")
  1.  E  D
  1.  .S ASUMV("E#","ASA")=ASUL(2,"STA","E#"),ASUF=1
  1.  Q:ASUMV("E#","ASA")=""
  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 ;
  1.  D
  1.  .I ASUMV("MODE")=3 S ASUF=0 K ^ASUV("AX",ASUMV("E#","ASA")) D ASUV3AN4 Q
  1.  .I ASUMV("MODE")=0 S ASUF=2,ASUV("MSG",2)="""INVENTORY" D MESSAGE Q
  1.  .I ASUMV("MODE")=1 S ASUF=2,ASUV("MSG",2)="""FIRST COUNTS" D MESSAGE Q
  1.  .I ASUMV("MODE")=2 S ASUF=2,ASUV("MSG",2)="""RE-COUNTS" D MESSAGE Q
  1.  .S ASUF=1,ASUV("MSG",2)="!,""RESEARCH COMPLETED FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"
  1.  .S ASUV("MSG")="!,""WHICH IS IN COMPLETED MODE"""
  1.  .D MESSAGE2
  1.  I ASUF=0 Q
  1.  I ASUF=2 S ASUF=1 Q
  1.  Q:$D(DTOUT)!($D(DUOUT))
  1.  Q:$G(ASUK("PTR-Q"))
  1.  S DIR(0)="Y",DIR("A")="DO YOU WANT TO RE-PRINT THE ADJUSTMENT DOCUMENT? ",DIR("?")="ENTER 'Y' TO RE-PRINT OR 'N' TO CANCEL REQUEST" D ^DIR K DIR
  1.  I Y D
  1.  .S ASUF=0,ASUF("RPRN")=1
  1.  E  D
  1.  .S ASUF=1
  1.  Q
  1. MESSAGE ;
  1.  S ASUV("MSG")=ASUV("MSG",2)_" NOT "_$S(ASUMV("MODE")=0:"BEGUN",1:"COMPLETED")_" FOR ACCOUNT "_ASUMV("ACC")_" "_ASUL(9,"ACC","NM")_" INVENTORY"",!,""RESEARCH NOT ALLOWED"""
  1.  S ASUV("MSG",1)=$G(ASUV("MSG",1))
  1.  I ASUV("MSG",1)']"" D
  1.  .S ASUV("MSG",1)="W !,"
  1.  E  D
  1.  .S ASUV("MSG",1)="W !,"""_ASUV("MSG",1)_""",!,"
  1.  S ASURX=ASUV("MSG",1)_ASUV("MSG")
  1.  D V^ASUUPLOG
  1.  Q
  1. MESSAGE2 ;
  1.  S ASUV("MSG",1)=$G(ASUV("MSG",1))
  1.  S ASURX="W !,"""_ASUV("MSG",1)_""","_ASUV("MSG",2)_""""
  1.  I ASUV("MSG",1)="" D
  1.  .S ASUF=2
  1.  E  D
  1.  .S ASUF=1
  1.  D V^ASUUPLOG
  1.  Q
  1. ASUV3AN1 ;
  1.  S ASUR("ACC")=ASUMV("ACC")
  1.  F  D  I $D(DTOUT)!($D(DUOUT))!($G(ASUF)>0) Q
  1.  .W ! D ^ASUV9IDX I $D(DTOUT)!($D(DUOUT)) Q
  1.  .I ASUMX("E#","IDX")="" S ASUF=1 Q
  1.  .D READ^ASUMXDIO
  1.  .S ASUMV("E#","IDX")=ASUMX("IDX")
  1.  .I '$D(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"))) D
  1.  ..W !,"NO ADJUSTMENT NEEDED FOR THIS INDEX"
  1.  .E  D
  1.  ..D STALOOP
  1.  Q
  1. IXLOOP ;EP
  1.  S ASUMV("E#","IDX")=0
  1.  F  S ASUMV("E#","IDX")=$O(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"))) Q:ASUMV("E#","IDX")']""  D STALOOP Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  Q
  1. STALOOP ;
  1.  S ASUL(2,"STA","E#")=0
  1.  F  S ASUL(2,"STA","E#")=$O(^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#"))) Q:ASUL(2,"STA","E#")']""  D ASUV3AN2 Q:$D(DTOUT)  Q:$D(DUOUT)
  1.  Q
  1. ASUV3AN2 ;
  1.  S ASUMV(0,2)=^ASUV("AX",ASUMV("E#","ASA"),ASUMV("E#","IDX"),ASUL(2,"STA","E#"))
  1.  S ASUMV("E#","SLC")=$P(ASUMV(0,2),U)
  1.  S ASUMV("E#","INDX")=$P(ASUMV(0,2),U,2)
  1.  D ^ASUV9IMR
  1.  D READ^ASUMXDIO
  1.  S ASUMV("VAL","DIF")=ASUMV("QTY","DIF")*ASUMV("U/C")
  1.  I +ASUMV("QTY","DIF")>1!(ASUMV("QTY","DIF")<-1) D
  1.  .I ASUMV("VAL","DIF")'<25!(ASUMV("VAL","DIF")<-25) D
  1.  ..S ASUF("IDX")=0
  1.  ..I ASUR("RSVP")="Y" W !!,"INDEX : ",ASUMX("IDX")
  1.  ..S ASUMS("STA")=$P(^ASUMS(ASUMV("STA"),0),U)
  1.  ..W:ASUR("RSVP")="Y" ?15,ASUMX("DESC",1)
  1.  ..W ?65,"STATION : ",ASUMS("STA")
  1.  ..S DIR("B")=ASUMV("ADJQTY")
  1.  ..S DIR("A")="ENTER RSCH/ADJ MASTER QUANTITY"
  1.  ..S DIR(0)="NO^0:999999:0^K:X[""."" X" D ^DIR K DIR
  1.  ..I $D(DTOUT)!($D(DUOUT)) Q
  1.  ..S ASUR("QTY")=X
  1.  ..I ASUR("QTY")="" Q
  1.  ..S ASUMV("ADJQTY")=ASUR("QTY")
  1.  ..S ASUMV("QTY","DIF")=ASUMV("CNT","2ND")-ASUR("QTY")
  1.  ..S ASUMV("CNT-ENT")=3
  1.  E  D
  1.  .S ASUMV("CNT-ENT")=4
  1.  .Q:ASUR("RSVP")="Y"
  1.  .W !,"DIFFERENCE LESS THAN 1 OR VALUE LESS THAN $25.00 -NO RESEARCH COUNTS"
  1.  .S DIR(0)="E" D ^DIR K DIR
  1.  .S ASUMV("IDX")=""
  1.  D ^ASUV9IMW
  1.  Q
  1. ASUV3AN4 ;
  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.  ..S ASUF("QU")=0
  1.  ..D ^ASUV9IMR
  1.  ..I $G(ASUR("RSVP"))="N" D
  1.  ...I ASUMV("QTY","DIF")=0 D  Q:ASUF("QU")
  1.  ....I ASUMV("QTY","STAM")'=0 S ASUF("QU")=1 Q
  1.  ....I ASUMV("ADJQTY")=0 S ASUF("QU")=1 Q
  1.  ....I ASUMV("CNT","2ND")=0 S ASUF("QU")=1 Q
  1.  ....I ASUMV("CNT","1ST")=0 S ASUF("QU")=1 Q
  1.  ..;I ASUMV("CNT-ENT")>2 S ASUF("QU")=1 Q  ;ADJUSTMENT ALREADY ENTERED
  1.  ..I ASUF("QU")=0 D
  1.  ...S ASUF("IDX")=0
  1.  ...S ^ASUV("AX",ASUMV("E#","ASA"),ASUMV("IDX"),ASUMV("STA"))=ASUMV("E#","SLC")_U_ASUMV("E#","INDX")
  1.  Q