ACRFSS11 ;IHS/OIRM/DSD/THL,AEF - ACRFSS1 CON'T; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;CONTINUATION OF ACRFSS1
ORDER ;EP;
I $P(ACRDOC0,U,4)=35 D O1 Q
W @IOF
W !,"Select STANDARD ITEM by:"
S DIR(0)="SO^1:Index Number;2:National Stock Number;3:Vendor;4:Vendor/Manufacturer Product Number;5:National Drug Code;6:Description/Keyword"
D DIR^ACRFDIC
I ($D(ACRQUIT)!(X="")),$D(ACRTXDA),ACRTXDA,$D(^ACRTXTYP(ACRTXDA,0)),$P(^(0),U,4)="ST" D Q
.W !!,"STOCK ISSUES CAN ONLY BE ORDERED FROM STANDARD ITEM INVENTORY."
.H 2
Q:$D(ACROUT)
I X="" D O1 Q
I Y=1 S ACRXREF="B",DIR("A")="Index NO............"
I Y=2 S ACRXREF="NSN",DIR("A")="Nat'l Stock NO......"
I Y=3 S ACRXREF="F",DIR("A")="Vendor.............."
I Y=4 S ACRXREF="VON",DIR("A")="Vendor Product NO..."
I Y=5 S ACRXREF="NDC",DIR("A")="Nat'l Drug Code....."
I Y=6 S ACRXREF="C^D",DIR("A")="Description........."
S DIR(0)="FO^2:17",DIR("?")="^S X=""??"",DIC=""^ACRITEM("",DIC(0)=""EQZ"",D=ACRXREF D DIC^ACRFDIC"
W !
D DIR^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT) Q
I Y="" K ACRQUIT D O1 Q
S (ACRXX,X)=Y
S DIC="^ACRITEM("
S DIC(0)="EQZ"
S D=ACRXREF
D MIX^ACRFDIC
O2 I +Y>0 D Q
.S ACRJ=ACRJ+1
.S ACRITMDA=+Y
.S ACRX=$P(^ACRITEM(ACRITMDA,0),U)_" ("_$S($P(^(0),U,2)]"":$P(^(0),U,2),1:$P($G(^ACRITEM(ACRITMDA,2,1,0)),U))_")"
.S ACRSSDR="[ACR STANDARD ITEM-2]"
.D ADD1^ACRFSS1
.D APCHK^ACRFSCHK
.I $P(^ACRDOC(ACRDOCDA,0),U,4)=35,$E($G(^ACROBL(ACRDOCDA,"APV")))="A" Q
.D APPROVE^ACRFSCHK
W !!,"No STANDARD ITEM found"
S DIR(0)="YO"
S DIR("A")="Inquire to STANDARD ITEM file again"
S DIR("B")="NO"
K ACRQUIT,ACROUT
D DIR^ACRFDIC
K ACRQUIT
G:Y=1 ORDER
O1 ;ADD NEW ITEM WHICH IS NOT FROM THE STANDARD ITEM FILE TO THE REQUEST
K ACRXX
D ADD2^ACRFSS1
D APCHK^ACRFSCHK
I $P(^ACRDOC(ACRDOCDA,0),U,4)=35,$E($G(^ACROBL(ACRDOCDA,"APV")))="A" I 1
E D APPROVE^ACRFSCHK
ORDER1 S DIR(0)="YO"
S DIR("A")="Add another ITEM"
S DIR("B")="NO"
W !!
D DIR^ACRFDIC
G:Y=1 ORDER
Q
ACRFSS11 ;IHS/OIRM/DSD/THL,AEF - ACRFSS1 CON'T; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;CONTINUATION OF ACRFSS1
ORDER ;EP;
+1 IF $PIECE(ACRDOC0,U,4)=35
DO O1
QUIT
+2 WRITE @IOF
+3 WRITE !,"Select STANDARD ITEM by:"
+4 SET DIR(0)="SO^1:Index Number;2:National Stock Number;3:Vendor;4:Vendor/Manufacturer Product Number;5:National Drug Code;6:Description/Keyword"
+5 DO DIR^ACRFDIC
+6 IF ($DATA(ACRQUIT)!(X=""))
IF $DATA(ACRTXDA)
IF ACRTXDA
IF $DATA(^ACRTXTYP(ACRTXDA,0))
IF $PIECE(^(0),U,4)="ST"
Begin DoDot:1
+7 WRITE !!,"STOCK ISSUES CAN ONLY BE ORDERED FROM STANDARD ITEM INVENTORY."
+8 HANG 2
End DoDot:1
QUIT
+9 IF $DATA(ACROUT)
QUIT
+10 IF X=""
DO O1
QUIT
+11 IF Y=1
SET ACRXREF="B"
SET DIR("A")="Index NO............"
+12 IF Y=2
SET ACRXREF="NSN"
SET DIR("A")="Nat'l Stock NO......"
+13 IF Y=3
SET ACRXREF="F"
SET DIR("A")="Vendor.............."
+14 IF Y=4
SET ACRXREF="VON"
SET DIR("A")="Vendor Product NO..."
+15 IF Y=5
SET ACRXREF="NDC"
SET DIR("A")="Nat'l Drug Code....."
+16 IF Y=6
SET ACRXREF="C^D"
SET DIR("A")="Description........."
+17 SET DIR(0)="FO^2:17"
SET DIR("?")="^S X=""??"",DIC=""^ACRITEM("",DIC(0)=""EQZ"",D=ACRXREF D DIC^ACRFDIC"
+18 WRITE !
+19 DO DIR^ACRFDIC
+20 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+21 IF Y=""
KILL ACRQUIT
DO O1
QUIT
+22 SET (ACRXX,X)=Y
+23 SET DIC="^ACRITEM("
+24 SET DIC(0)="EQZ"
+25 SET D=ACRXREF
+26 DO MIX^ACRFDIC
O2 IF +Y>0
Begin DoDot:1
+1 SET ACRJ=ACRJ+1
+2 SET ACRITMDA=+Y
+3 SET ACRX=$PIECE(^ACRITEM(ACRITMDA,0),U)_" ("_$SELECT($PIECE(^(0),U,2)]"":$PIECE(^(0),U,2),1:$PIECE($GET(^ACRITEM(ACRITMDA,2,1,0)),U))_")"
+4 SET ACRSSDR="[ACR STANDARD ITEM-2]"
+5 DO ADD1^ACRFSS1
+6 DO APCHK^ACRFSCHK
+7 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A"
QUIT
+8 DO APPROVE^ACRFSCHK
End DoDot:1
QUIT
+9 WRITE !!,"No STANDARD ITEM found"
+10 SET DIR(0)="YO"
+11 SET DIR("A")="Inquire to STANDARD ITEM file again"
+12 SET DIR("B")="NO"
+13 KILL ACRQUIT,ACROUT
+14 DO DIR^ACRFDIC
+15 KILL ACRQUIT
+16 IF Y=1
GOTO ORDER
O1 ;ADD NEW ITEM WHICH IS NOT FROM THE STANDARD ITEM FILE TO THE REQUEST
+1 KILL ACRXX
+2 DO ADD2^ACRFSS1
+3 DO APCHK^ACRFSCHK
+4 IF $PIECE(^ACRDOC(ACRDOCDA,0),U,4)=35
IF $EXTRACT($GET(^ACROBL(ACRDOCDA,"APV")))="A"
IF 1
+5 IF '$TEST
DO APPROVE^ACRFSCHK
ORDER1 SET DIR(0)="YO"
+1 SET DIR("A")="Add another ITEM"
+2 SET DIR("B")="NO"
+3 WRITE !!
+4 DO DIR^ACRFDIC
+5 IF Y=1
GOTO ORDER
+6 QUIT
