- 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
