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

ASUUSCRN.m

Go to the documentation of this file. 
  1. ASUUSCRN ; IHS/ITSC/LMH -GENERIC SCREEN FOR AREA ROUTINE ;  [ 07/18/2000  7:23 AM ]
  1.  ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
  1.  ;This routine provides screening logic for internal record numbers
  1.  ;(E#) for all SAMS files which has them defined as requiring an
  1.  ;Area's Accounting Point as the first two digits.
  1.  ;IHS/ITSC/MRS 7/17/2000-Modified to return DUZ(2) unchanged from DUZ(2)
  1.  ;      sub-routine. No exit flag needs to be set at this point.
  1. EN1 ;EP ;PRIMARY ENTRY POINT
  1.  ;W !,"Now in Screening routine - X = ",$G(X)," Y = ",$G(Y)
  1.  D:'$D(DUZ(2)) AREA Q:'$D(ASUL(1))
  1.  I '$D(ASUL(1,"AR","AP")) D
  1.  .S:$D(X) X("OLD")=X
  1.  .D SETAREA^ASULARST
  1.  .S:$D(X("OLD")) X=X("OLD")
  1.  .K X("OLD")
  1.  I ASUL(1,"AR","WHSE")=3 S X("INDR")="I 1" G TEST  ;Regional Warehouse may look at all areas
  1.  I $D(Y) D  G TEST
  1.  .I $E(Y,1,2)=ASUL(1,"AR","AP") D
  1.  ..S X("INDR")="I 1"
  1.  .E  D
  1.  ..S X("INDR")="I 0"
  1.  S DIC("S")=$G(DO("SCR")) K:DIC("S")']"" DIC("S")
  1.  D
  1.  .I $D(X) D
  1.  ..I $E(X,1,2)=ASUL(1,"AR","AP") S X("INDR")="I 1"
  1.  .E  D
  1.  ..S X("INDR")="I 0"
  1. AREA ;ALSO LOCAL ENTRY FROM EN1 IF '$D(DUZ(2))
  1.  N Z
  1.  S Z=$P($G(^ASUSITE(1,0)),U) I Z]"" D  Q:'$D(DUZ(2))
  1.  .D DUZ(Z)
  1.  E  D
  1.  .W !,"No Site file entry"
  1.  D ARE^ASULARST(Z) W:'$D(ASUL(1)) !,"Not able to find Area"
  1.  Q
  1. DUZ(X) ;
  1.  ;Modified to return DUZ(2) unchanged
  1.  ;No exit flag apparently needs to be set at this point MRS:7/17/2000
  1.  Q
  1.  ;N Y
  1.  ;S Y(1)=$O(^AUTTLOC("C",X_"0000")) I Y(1)]"" D
  1.  ;.S Y=$O(^AUTTLOC("C",Y(1),"")) S DUZ(2)=Y
  1.  ;Q
  1. SST(Y) ;EP ;PASSING X
  1.  D EN1
  1.  K:'$T Y
  1.  Q
  1. IDX ;EP ;FOR INDEX NUMBER
  1.  I $D(X) I X["999999" S X("INDR")="I 0" G TEST
  1.  G EN1
  1. TEST ;
  1.  X X("INDR") K X("INDR")
  1.  Q
  1. ARE ;EP ;REGIONAL CHECK
  1.  Q:ASUL(1,"AR","WHSE")=3  ;Regional Warehouse may look at all areas
  1.  S DO("SCR")="I $P(^(0),U,2)'=$G(ASUL(1,""AR"",""AP"")"
  1.  Q
  1. CHK() ;EP;CALLED BY; ^DD(9002039.18
  1.  ;KERNEL ONLY
  1.  N Y
  1.  S Y=''$D(DUZ(2))
  1.  I 'Y W !,*7,"Use SAMS package menu options, not VA Fileman"
  1.  Q Y
  1.  ;
  1. SCR(X) ;EP;CALLED BY; ^DD(9002039.18 ;ASUTBL SUB STATION ;SCREEN FOR AREA
  1.  N Y,Z
  1.  Q:'$D(ASUL(1)) 0
  1.  Q:$G(ASUL(1,"AR","WHSE"))=3 1
  1.  I X?1N.N Q:$G(ASUL(1,"AR","AP"))'=$E(X,1,2) 0
  1.  Q 1
  1.  ;
  1. FSCR() ;EP;CALLED BY; ^DD(9002031; ASUMST STATION
  1.  ;^DD(9002036; ASUHST HISTORY TRANSACTIONS
  1.  ;^DD(9002036.1; ASUTRN DUE IN; ASUTRN DUE IS
  1.  ;^DD(9002036.2; ASUTRN RECEIPTS
  1.  ;^DD(9002036.3; ASUTRN ISSUES
  1.  ;^DD(9002036.4; ASUTRN INDEX
  1.  ;^DD(9002036.5; ASUTRN STATION
  1.  ;^DD(9002036.6; ASUTRN ADJUSTMENT
  1.  ;^DD(9002036.7; ASUTRN DIRECT ISSUE
  1.  ;^DD(9002036.8; ASUJIB ISSUE BOOK
  1.  ;^DD(9002039.01; ASUTBL AREA
  1.  ;^DD(9002039.02; ASUTBL STATION
  1.  ;^DD(9002039.18; ASUTBL SUB STATION
  1.  ;^DD(9002039.19; ASUTBL USER
  1.  ;^DD(9002039.21; ASUTBL BUDGET
  1.  ; LOOKUP SCREEN MOST FILES
  1.  ;      SCREENS ENTRIES FROM LOOKUP, PRINT, INQUIRY, SEARCH AND OTHER
  1.  ;      ACTIONS
  1.  ;
  1.  D:'$D(ASUL(1)) AREA Q:'$D(ASUL(1)) 0
  1.  Q:$G(ASUL(1,"AR","AP"))=65 1
  1.  Q:$G(ASUL(1,"AR","WHSE"))=3 1
  1.  Q:$P(^(0),U,2)'=$G(ASUL(1,"AR","AP")) 0
  1.  Q 1
  1. FSCX() ;EP;^DD(9002032;ASUMST INDEX; LOOKUP SCREEN FOR INDEX MASTER
  1.  ;
  1.  ;      SCREENS ENTRIES FROM LOOKUP, PRINT, INQUIRY, SEARCH AND OTHER
  1.  ;      ACTIONS
  1.  ;
  1.  D:'$D(ASUL(1)) AREA Q:'$D(ASUL(1)) 0
  1.  Q:$G(ASUL(1,"AR","WHSE"))=3 1
  1.  S:$P(^(0),U,11)']"" $P(^(0),U,11)=$E($G(Y),1,2)
  1.  Q:$P(^(0),U,11)'=$G(ASUL(1,"AR","AP")) 0
  1.  Q:$E($G(Y),3,8)=999999 0
  1.  Q 1
  1. FSCU() ;EP;CALLED BY; ^DD(9002039.2; ASUTBL REQUSITIONER
  1.  ;-- LOOKUP SCREEN FOR REQUSITIONER FILE
  1.  ;
  1.  ;      SCREENS ENTRIES FROM LOOKUP, PRINT, INQUIRY, SEARCH AND OTHER
  1.  ;      ACTIONS
  1.  ;
  1.  D:'$D(ASUL(1)) AREA Q:'$D(ASUL(1)) 0
  1.  Q:$G(ASUL(1,"AR","WHSE"))=3 1
  1.  Q:$P(^(0),U,4)'=$G(ASUL(1,"AR","AP")) 0
  1.  Q 1