ASUMDIRM ; IHS/ITSC/LMH -DIRECT LOOK UP RECORD ;
;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
;This routine is a utility which provides entry points to lookup
;entries in SAMS Station (in ^ASUMS) and Index (in ^ASUMX) Master
;files.
DIS(X) ;EP ; DIRECT STATION MASTER LOOKUP
I $L(X)=3 S X=ASUL(1,"AR","AP")_X
I $L(X)=2 S X=$S(X="PL":ASUL(1,"AR","AP")_999,1:ASUL(1,"AR","AP")_"0"_X)
I X'?5N D Q
.S Y=-4 Q ;Input paramater did not pass Station IEN edit
I $D(^ASUMS(X,0)) D
.S (Y,ASUMS("E#","STA"))=X ;Record found for input parameter
.S:$P(^ASUMS(Y,0),U)="" Y=-9 ;Deleted Station Master
E D
.S ASUMS("E#","STA")=X ;IEN to use for LAYGO call
.S Y=-1 ;K ASUMS("E#","STA") No record found for Input parameter
Q
DISX(X) ;EP ; DIRECT STATION MASTER INDEX LOOKUP -MUST HAVE IEN FOR STATION
;WAR 4/21/99 - rewrote this paragraph - it was never being called
S ASUMS(0)=$G(^ASUMS(ASUL(2,"STA","E#"),1,X,0)) ;X=Area Code_IDX#
S ASUMS(2)=$G(^ASUMS(ASUL(2,"STA","E#"),1,X,2))
I ASUMS(0)'="" D ;$D(^ASUMS(ASUL(2,"STA","E#"),1,X,0)) D
.I $P(ASUMS(0),U)'[999999 D
..S Y=X ;Y is used by calling Rtn (ASUJVALF)
..I +$P(ASUMS(0),U,17)=0 D
...I '$P(ASUMS(0),U,18)&('$P(ASUMS(0),U,23))&('$P(ASUMS(0),U,28))&('$P(ASUMS(2),U,2)) D
....;Nothing for now, delete is performed in ASU5SUPD
....;S $P(^ASUMS(ASUL(2,"STA","E#"),1,X,0),U)=ASUL(1,"AR","E#")_999999
....;S DIK="^ASUMS("_ASUL(2,"STA","E#")_",1,"
....;S DA=X,DA(1)=ASUL(2,"STA","E#")
....;D IX^DIK K DIK,DA
....;these next 4 lines would allow FM to do the Del & Re-ndx
....;S DIE="^ASUMS("_ASUL(2,"STA","E#")_",1,"
....;S DA=X,DA(1)=ASUL(2,"STA","E#")
....;S DR=".01///"_$E(X,3,7)_"."_$E(X,8)
....;D ^DIE
...E D
....I ASUJ=5 D CHKSTA ;Due ins are not 0
..E D
...I ASUJ=5 D CHKSTA ;Qty On Hand is not 0
.E D
..D IDXDL^ASUJHELP
..S Y=-9 ;Already deleted
E D
.I $G(ASUT("TRCD"))'="5A" D
..S Y=-1 ;Record not found
Q
CHKSTA ;
I ASUT'="STA"&(ASUT'="STC")&(ASUT'="STB") D
.D QTYORDI^ASUJHELP
Q
DIX(X) ;EP ; DIRECT INDEX MASTER LOOKUP
I $L(X)=6 S X=ASUL(1,"AR","AP")_X
I X'?8N S Y=-4 Q ;Input paramater did not pass Index IEN edit
I $D(^ASUMX(X,0)) D
.S (Y,ASUMX("E#","IDX"))=X ;Record found for input parameter
.S:$P(^ASUMX(X,0),U)[999999 Y=-9 ;Deleted Index Master
E D
.S Y=-1 K ASUMX("E#","IDX") ;No record found for Input parameter
Q
ASUMDIRM ; IHS/ITSC/LMH -DIRECT LOOK UP RECORD ;
+1 ;;4.2T2;Supply Accounting Mgmt. System;;JUN 30, 2000
+2 ;This routine is a utility which provides entry points to lookup
+3 ;entries in SAMS Station (in ^ASUMS) and Index (in ^ASUMX) Master
+4 ;files.
DIS(X) ;EP ; DIRECT STATION MASTER LOOKUP
+1 IF $LENGTH(X)=3
SET X=ASUL(1,"AR","AP")_X
+2 IF $LENGTH(X)=2
SET X=$SELECT(X="PL":ASUL(1,"AR","AP")_999,1:ASUL(1,"AR","AP")_"0"_X)
+3 IF X'?5N
Begin DoDot:1
+4 ;Input paramater did not pass Station IEN edit
SET Y=-4
QUIT
End DoDot:1
QUIT
+5 IF $DATA(^ASUMS(X,0))
Begin DoDot:1
+6 ;Record found for input parameter
SET (Y,ASUMS("E#","STA"))=X
+7 ;Deleted Station Master
IF $PIECE(^ASUMS(Y,0),U)=""
SET Y=-9
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 ;IEN to use for LAYGO call
SET ASUMS("E#","STA")=X
+10 ;K ASUMS("E#","STA") No record found for Input parameter
SET Y=-1
End DoDot:1
+11 QUIT
DISX(X) ;EP ; DIRECT STATION MASTER INDEX LOOKUP -MUST HAVE IEN FOR STATION
+1 ;WAR 4/21/99 - rewrote this paragraph - it was never being called
+2 ;X=Area Code_IDX#
SET ASUMS(0)=$GET(^ASUMS(ASUL(2,"STA","E#"),1,X,0))
+3 SET ASUMS(2)=$GET(^ASUMS(ASUL(2,"STA","E#"),1,X,2))
+4 ;$D(^ASUMS(ASUL(2,"STA","E#"),1,X,0)) D
IF ASUMS(0)'=""
Begin DoDot:1
+5 IF $PIECE(ASUMS(0),U)'[999999
Begin DoDot:2
+6 ;Y is used by calling Rtn (ASUJVALF)
SET Y=X
+7 IF +$PIECE(ASUMS(0),U,17)=0
Begin DoDot:3
+8 IF '$PIECE(ASUMS(0),U,18)&('$PIECE(ASUMS(0),U,23))&('$PIECE(ASUMS(0),U,28))&('$PIECE(ASUMS(2),U,2))
Begin DoDot:4
+9 ;Nothing for now, delete is performed in ASU5SUPD
+10 ;S $P(^ASUMS(ASUL(2,"STA","E#"),1,X,0),U)=ASUL(1,"AR","E#")_999999
+11 ;S DIK="^ASUMS("_ASUL(2,"STA","E#")_",1,"
+12 ;S DA=X,DA(1)=ASUL(2,"STA","E#")
+13 ;D IX^DIK K DIK,DA
+14 ;these next 4 lines would allow FM to do the Del & Re-ndx
+15 ;S DIE="^ASUMS("_ASUL(2,"STA","E#")_",1,"
+16 ;S DA=X,DA(1)=ASUL(2,"STA","E#")
+17 ;S DR=".01///"_$E(X,3,7)_"."_$E(X,8)
+18 ;D ^DIE
End DoDot:4
+19 IF '$TEST
Begin DoDot:4
+20 ;Due ins are not 0
IF ASUJ=5
DO CHKSTA
End DoDot:4
End DoDot:3
+21 IF '$TEST
Begin DoDot:3
+22 ;Qty On Hand is not 0
IF ASUJ=5
DO CHKSTA
End DoDot:3
End DoDot:2
+23 IF '$TEST
Begin DoDot:2
+24 DO IDXDL^ASUJHELP
+25 ;Already deleted
SET Y=-9
End DoDot:2
End DoDot:1
+26 IF '$TEST
Begin DoDot:1
+27 IF $GET(ASUT("TRCD"))'="5A"
Begin DoDot:2
+28 ;Record not found
SET Y=-1
End DoDot:2
End DoDot:1
+29 QUIT
CHKSTA ;
+1 IF ASUT'="STA"&(ASUT'="STC")&(ASUT'="STB")
Begin DoDot:1
+2 DO QTYORDI^ASUJHELP
End DoDot:1
+3 QUIT
DIX(X) ;EP ; DIRECT INDEX MASTER LOOKUP
+1 IF $LENGTH(X)=6
SET X=ASUL(1,"AR","AP")_X
+2 ;Input paramater did not pass Index IEN edit
IF X'?8N
SET Y=-4
QUIT
+3 IF $DATA(^ASUMX(X,0))
Begin DoDot:1
+4 ;Record found for input parameter
SET (Y,ASUMX("E#","IDX"))=X
+5 ;Deleted Index Master
IF $PIECE(^ASUMX(X,0),U)[999999
SET Y=-9
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 ;No record found for Input parameter
SET Y=-1
KILL ASUMX("E#","IDX")
End DoDot:1
+8 QUIT
