ACRFSTOK ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT STOCK ITEMS; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO ADD OR EDIT STANDARD ITEMS
ITEM F D ITEM1 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK
Q
ITEM1 W @IOF
K ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK
W !?22,"ADD/EDIT STANDARD ITEMS"
W !?21,"|==============================|"
S DIR(0)="FO^1:30"
S DIR("A")="STANDARD ITEM......."
S DIR("?")="^ S DIC=""^ACRITEM("",DIC(0)=""EMZ"" D DIC^ACRFDIC K DIC"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)!(X="")!($E(X)=U)!($E(X)="?")
S ACRX=X
S DIC="^ACRITEM("
S DIC(0)="EMZ"
S DIC("S")="Q:'$D(^ACRITEM(+Y,""DT1"")) I $P(^(""DT1""),U,3)=1!($P(^(""DT1""),U,3)="""")"
D DIC^ACRFDIC
I $D(ACRQUIT)!$D(ACROUT)!('$L(X)) K ACRQUIT Q
S ACRDA=Y
I +ACRDA<1,$L(X)>2 D I $D(ACRQUIT) K ACRQUIT Q
.S DIR(0)="YOA"
.S DIR("A")=" ADD "_X_" AS A NEW ARMS STANDARD ITEM? "
.D DIR^ACRFDIC
.I Y'=1 S ACRQUIT="" Q
.S DIC("DR")="1////"_ACRX
.D NEW^ACRFSTK1
ITEM11 ;EDIT A STANDARD ITEM
Q:+ACRDA<1
I $P($G(^ACRITEM(+ACRDA,"DT1")),U,3)'=1,$P($G(^ACRITEM(+ACRDA,"DT")),U)]"" D
.S ACRPDA=$P(^ACRITEM(+ACRDA,"DT"),U,15)
.Q:'ACRPDA
.S ACRYY=0
.F S ACRYY=$O(^ACRITEM("G",ACRPDA,ACRYY)) Q:'ACRYY I $D(^ACRITEM(ACRYY,"DT1")),$P(^("DT1"),U,3)=1 S ACRDA=ACRYY Q
S (ACRD0,ACRITMDA)=+ACRDA
S ACRSEQ=1
N ACRY
S ACRY=$P(ACRDA,U,3)
F D ITEM2 Q:$D(ACRQUIT)!$D(ACROUT)
K ACRQUIT
I ACRSEQ<3,$G(ACR(1)),'$D(ACRDEL),$P($G(^ACRITEM(+ACR(1),"DT1")),U) D
.F D ITEM5 Q:$D(ACRQUIT)!$D(ACROUT)!(ACRSEQ>2)
K ACRQUIT,ACRDEL
Q
ITEM2 I ACRY=1 S ACRSEQ=1 D ITEM3 Q:$D(ACRQUIT)!$D(ACROUT)
D DISP^ACRFSTK1
I ACRSEQ>1 D
.S DIR(0)="YO"
.S DIR("A")="Change Vendor priority"
.S DIR("B")="NO"
.D DIR^ACRFDIC
.I Y=1 D
..I ACRSEQ=2 D
...S ACRX=ACR(2)
...S ACR(2)=ACR(1)
...S ACR(1)=ACRX
...F ACRX=1,2 D
....S DA=+ACR(ACRX)
....S DIE="^ACRITEM("
....S DR="15////"_+ACR(1)_";26////"_ACRX
....D DIE^ACRFDIC
..I ACRSEQ=3 D
...F ACRX=1:1:3 S ACRX(ACRX)=$G(ACR(ACRX))
...S ACRPRI=0
...W !
...F S ACRPRI=$O(ACR(ACRPRI)) Q:'ACRPRI
...S DIR(0)="SOB^2:"_$P(ACR(2),U,3)_";3:"_$P(ACR(3),U,3)
...S DIR("A")="New Primary Vendor"
...D DIR^ACRFDIC
...I Y D
....S ACRX=Y
....S ACRX(Y)=ACR(1)
....S ACRX(1)=ACR(Y)
....S ACRSET="1:"_$P(ACR(1),U,3)_";"
....S ACRSET=$S(Y=2:ACRSET_"3:"_$P(ACR(3),U,3),1:ACRSET_"2:"_$P(ACR(2),U,3))
...Q:'Y
...S DIR(0)="SOB^"_ACRSET
...S DIR("A")="New Secondary Vendor"
...D DIR^ACRFDIC
...I Y=1 D
....S ACRX(2)=ACR(Y)
....S ACRX(3)=ACR($S(ACRX+Y=3:3,ACRX+Y=4:2,1:1))
...F ACRX=1:1:3 D
....S ACR(ACRX)=ACRX(ACRX)
....S DA=+ACR(ACRX)
....S DIE="^ACRITEM("
....S DR="15////"_+ACR(1)_";26////"_ACRX
....D DIE^ACRFDIC
K ACRQUIT
S DIR(0)="YO"
S DIR("A")="Edit Item Data........"
S DIR("B")="NO"
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
D ITEM3
Q
ITEM3 S ACRY=""
D:'$D(ACRADD) ITEM4
ITEM31 Q:$D(ACRQUIT)!$D(ACROUT)
S:'$D(Y) Y="G"
S:"123G"'[Y Y="G"
S:Y="G" ACRG=""
S DA=+ACRDA
S DR=$S(Y:"[ACR DI VENDOR]",1:"[ACR ADD DIRECT ISSUE]")
K ACRSSITM
ITEM311 S DIE="^ACRITEM("
S ACRITEM=""
S:$D(^ACRITEM(ACRDA,"DT1")) ACRMESS=$S(DR["SEC":"VENDOR - "_$S($P(^("DT1"),U)]"":$P(^AUTTVNDR($P(^ACRITEM(ACRDA,"DT1"),U),0),U),1:""),1:"STANDARD ITEM GENERAL INFO")
D DIE^ACRFDIC
K ACRITEM
I $D(ACRG) F ACR=2,3 D:$D(ACR(ACR))
.S ^ACRITEM(+ACR(ACR),"DT")=^ACRITEM(ACRDA,"DT")
.S:$D(^ACRITEM(ACRDA,"DT2")) ^ACRITEM(+ACR(ACR),"DT2")=^ACRITEM(ACRDA,"DT2")
.K ACRG
I $D(ACRDEL) D DELETE^ACRFSTK1
Q
ITEM4 K ACRADD
S ACRSET="G:GENERAL INFORMATION;"_$S(ACRSEQ=1:"1:PRIMARY VENDOR",ACRSEQ=2:"1:PRIMARY VENDOR;2:SECONDARY VENDOR",1:"1:PRIMARY VENDOR;2:SECONDARY VENDOR;3:TERTIARY VENDOR")
S DIR(0)="SO^"_ACRSET
S DIR("A")="Which OPTION"
D DIR^ACRFDIC
Q:$D(ACRQUIT)!$D(ACROUT)
Q:Y=""
Q:'$D(ACR(Y))&'$D(ACR(1))
S ACRDA=$S(Y&$D(ACR(Y)):+ACR(Y),1:+ACR(1))
S:Y>1 ACRDEL=+ACR(Y)_U_Y
Q
ITEM5 S DIR(0)="YO"
S DIR("A")="Add a "_$S(ACRSEQ=1:"Secondary",1:"Tertiary ")_" Vendor"
S DIR("B")="NO"
D DIR^ACRFDIC
I Y'=1 S ACRQUIT="" Q
S DIC="^AUTTVNDR("
S DIC(0)="AEMQZ"
S DIC("A")="VENDOR..............: "
D DIC^ACRFDIC
Q:+Y<1!$D(ACRQUIT)!$D(ACROUT)
S ACRVDA=+Y,ACR=0
S ACRSEQ=ACRSEQ+1
S X=ACRINDEX
S DIC(0)="L"
S DIC="^ACRITEM("
S DIC("DR")="24////"_ACRVDA_";26////"_ACRSEQ
D FILE^ACRFDIC
Q:+Y<1
S (DA,ACRDA)=+Y
S $P(^ACRITEM(+Y,0),U,2)=$P(^ACRITEM(ACRDA(1),0),U,2)
S ^ACRITEM(+Y,"DT")=^ACRITEM(+ACRDA(1),"DT")
S DIK="^ACRITEM("
D IX1^ACRFDIC
S DA=+ACRDA
S DIE="^ACRITEM("
S DR=".03////"_ACRSEQ_";15////"_+ACRDA(1)_";26////"_ACRSEQ
D DIE^ACRFDIC
S (DA,ACRDA(ACRSEQ))=ACRDA
S DR="[ACR DI VENDOR]"
D ITEM311
Q
ADD ;EP;TO ADD ITEM TO SI FILE DURING PO PROCESSING
S ACRADD=""
S ACRSSITM=""
S X=^ACRSS(ACRSSDA,0)
S ACRDT=$G(^ACRSS(ACRSSDA,"DT"))
S ACRKW=$G(^ACRSS(ACRSSDA,"NMS"))
S ACRVND=$G(^ACRSS(ACRSSDA,"VND"))
S ACRDSC=$G(^ACRSS(ACRSSDA,"DESC"))
S:ACRDSC[";" ACRDSC=$TR(ACRDSC,";",",")
S DIC="^ACRITEM("
S DIC(0)="LZ"
S DIC("DR")=".02////"_$E($P(ACRKW,U,5),1,16)_";1////"_$P(ACRDSC,U)_";2////"_$P(ACRDSC,U,2)_";4////"_$P(ACRDT,U,4)_";29////"_$P(ACRDT,U,2)_";12////"_$P(ACRDT,U,2)_";13////"_$P(ACRDT,U,3)_";8////"_DT_";6////"_$P(X,U,4)
S DIC("DR")=DIC("DR")_";24////"_+ACRVND_";50////"_$P(ACRDSC,U,3)_";51////"_$P(ACRDSC,U,4)_";52////"_$P(ACRDSC,U,5)
D NEW^ACRFSTK1
D ITEM11
K ACRSSITM
Q
ACRFSTOK ;IHS/OIRM/DSD/THL,AEF - ADD/EDIT STOCK ITEMS; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO ADD OR EDIT STANDARD ITEMS
ITEM FOR
DO ITEM1
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 KILL ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK
+2 QUIT
ITEM1 WRITE @IOF
+1 KILL ACRQUIT,ACR,ACRSEQ,ACRDA,ACRSET,ACRSTOCK
+2 WRITE !?22,"ADD/EDIT STANDARD ITEMS"
+3 WRITE !?21,"|==============================|"
+4 SET DIR(0)="FO^1:30"
+5 SET DIR("A")="STANDARD ITEM......."
+6 SET DIR("?")="^ S DIC=""^ACRITEM("",DIC(0)=""EMZ"" D DIC^ACRFDIC K DIC"
+7 DO DIR^ACRFDIC
+8 IF $DATA(ACRQUIT)!$DATA(ACROUT)!(X="")!($EXTRACT(X)=U)!($EXTRACT(X)="?")
QUIT
+9 SET ACRX=X
+10 SET DIC="^ACRITEM("
+11 SET DIC(0)="EMZ"
+12 SET DIC("S")="Q:'$D(^ACRITEM(+Y,""DT1"")) I $P(^(""DT1""),U,3)=1!($P(^(""DT1""),U,3)="""")"
+13 DO DIC^ACRFDIC
+14 IF $DATA(ACRQUIT)!$DATA(ACROUT)!('$LENGTH(X))
KILL ACRQUIT
QUIT
+15 SET ACRDA=Y
+16 IF +ACRDA<1
IF $LENGTH(X)>2
Begin DoDot:1
+17 SET DIR(0)="YOA"
+18 SET DIR("A")=" ADD "_X_" AS A NEW ARMS STANDARD ITEM? "
+19 DO DIR^ACRFDIC
+20 IF Y'=1
SET ACRQUIT=""
QUIT
+21 SET DIC("DR")="1////"_ACRX
+22 DO NEW^ACRFSTK1
End DoDot:1
IF $DATA(ACRQUIT)
KILL ACRQUIT
QUIT
ITEM11 ;EDIT A STANDARD ITEM
+1 IF +ACRDA<1
QUIT
+2 IF $PIECE($GET(^ACRITEM(+ACRDA,"DT1")),U,3)'=1
IF $PIECE($GET(^ACRITEM(+ACRDA,"DT")),U)]""
Begin DoDot:1
+3 SET ACRPDA=$PIECE(^ACRITEM(+ACRDA,"DT"),U,15)
+4 IF 'ACRPDA
QUIT
+5 SET ACRYY=0
+6 FOR
SET ACRYY=$ORDER(^ACRITEM("G",ACRPDA,ACRYY))
IF 'ACRYY
QUIT
IF $DATA(^ACRITEM(ACRYY,"DT1"))
IF $PIECE(^("DT1"),U,3)=1
SET ACRDA=ACRYY
QUIT
End DoDot:1
+7 SET (ACRD0,ACRITMDA)=+ACRDA
+8 SET ACRSEQ=1
+9 NEW ACRY
+10 SET ACRY=$PIECE(ACRDA,U,3)
+11 FOR
DO ITEM2
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+12 KILL ACRQUIT
+13 IF ACRSEQ<3
IF $GET(ACR(1))
IF '$DATA(ACRDEL)
IF $PIECE($GET(^ACRITEM(+ACR(1),"DT1")),U)
Begin DoDot:1
+14 FOR
DO ITEM5
IF $DATA(ACRQUIT)!$DATA(ACROUT)!(ACRSEQ>2)
QUIT
End DoDot:1
+15 KILL ACRQUIT,ACRDEL
+16 QUIT
ITEM2 IF ACRY=1
SET ACRSEQ=1
DO ITEM3
IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 DO DISP^ACRFSTK1
+2 IF ACRSEQ>1
Begin DoDot:1
+3 SET DIR(0)="YO"
+4 SET DIR("A")="Change Vendor priority"
+5 SET DIR("B")="NO"
+6 DO DIR^ACRFDIC
+7 IF Y=1
Begin DoDot:2
+8 IF ACRSEQ=2
Begin DoDot:3
+9 SET ACRX=ACR(2)
+10 SET ACR(2)=ACR(1)
+11 SET ACR(1)=ACRX
+12 FOR ACRX=1,2
Begin DoDot:4
+13 SET DA=+ACR(ACRX)
+14 SET DIE="^ACRITEM("
+15 SET DR="15////"_+ACR(1)_";26////"_ACRX
+16 DO DIE^ACRFDIC
End DoDot:4
End DoDot:3
+17 IF ACRSEQ=3
Begin DoDot:3
+18 FOR ACRX=1:1:3
SET ACRX(ACRX)=$GET(ACR(ACRX))
+19 SET ACRPRI=0
+20 WRITE !
+21 FOR
SET ACRPRI=$ORDER(ACR(ACRPRI))
IF 'ACRPRI
QUIT
+22 SET DIR(0)="SOB^2:"_$PIECE(ACR(2),U,3)_";3:"_$PIECE(ACR(3),U,3)
+23 SET DIR("A")="New Primary Vendor"
+24 DO DIR^ACRFDIC
+25 IF Y
Begin DoDot:4
+26 SET ACRX=Y
+27 SET ACRX(Y)=ACR(1)
+28 SET ACRX(1)=ACR(Y)
+29 SET ACRSET="1:"_$PIECE(ACR(1),U,3)_";"
+30 SET ACRSET=$SELECT(Y=2:ACRSET_"3:"_$PIECE(ACR(3),U,3),1:ACRSET_"2:"_$PIECE(ACR(2),U,3))
End DoDot:4
+31 IF 'Y
QUIT
+32 SET DIR(0)="SOB^"_ACRSET
+33 SET DIR("A")="New Secondary Vendor"
+34 DO DIR^ACRFDIC
+35 IF Y=1
Begin DoDot:4
+36 SET ACRX(2)=ACR(Y)
+37 SET ACRX(3)=ACR($SELECT(ACRX+Y=3:3,ACRX+Y=4:2,1:1))
End DoDot:4
+38 FOR ACRX=1:1:3
Begin DoDot:4
+39 SET ACR(ACRX)=ACRX(ACRX)
+40 SET DA=+ACR(ACRX)
+41 SET DIE="^ACRITEM("
+42 SET DR="15////"_+ACR(1)_";26////"_ACRX
+43 DO DIE^ACRFDIC
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+44 KILL ACRQUIT
+45 SET DIR(0)="YO"
+46 SET DIR("A")="Edit Item Data........"
+47 SET DIR("B")="NO"
+48 DO DIR^ACRFDIC
+49 IF Y'=1
SET ACRQUIT=""
QUIT
+50 DO ITEM3
+51 QUIT
ITEM3 SET ACRY=""
+1 IF '$DATA(ACRADD)
DO ITEM4
ITEM31 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+1 IF '$DATA(Y)
SET Y="G"
+2 IF "123G"'[Y
SET Y="G"
+3 IF Y="G"
SET ACRG=""
+4 SET DA=+ACRDA
+5 SET DR=$SELECT(Y:"[ACR DI VENDOR]",1:"[ACR ADD DIRECT ISSUE]")
+6 KILL ACRSSITM
ITEM311 SET DIE="^ACRITEM("
+1 SET ACRITEM=""
+2 IF $DATA(^ACRITEM(ACRDA,"DT1"))
SET ACRMESS=$SELECT(DR["SEC":"VENDOR - "_$SELECT($PIECE(^("DT1"),U)]"":$PIECE(^AUTTVNDR($PIECE(^ACRITEM(ACRDA,"DT1"),U),0),U),1:""),1:"STANDARD ITEM GENERAL INFO")
+3 DO DIE^ACRFDIC
+4 KILL ACRITEM
+5 IF $DATA(ACRG)
FOR ACR=2,3
IF $DATA(ACR(ACR))
Begin DoDot:1
+6 SET ^ACRITEM(+ACR(ACR),"DT")=^ACRITEM(ACRDA,"DT")
+7 IF $DATA(^ACRITEM(ACRDA,"DT2"))
SET ^ACRITEM(+ACR(ACR),"DT2")=^ACRITEM(ACRDA,"DT2")
+8 KILL ACRG
End DoDot:1
+9 IF $DATA(ACRDEL)
DO DELETE^ACRFSTK1
+10 QUIT
ITEM4 KILL ACRADD
+1 SET ACRSET="G:GENERAL INFORMATION;"_$SELECT(ACRSEQ=1:"1:PRIMARY VENDOR",ACRSEQ=2:"1:PRIMARY VENDOR;2:SECONDARY VENDOR",1:"1:PRIMARY VENDOR;2:SECONDARY VENDOR;3:TERTIARY VENDOR")
+2 SET DIR(0)="SO^"_ACRSET
+3 SET DIR("A")="Which OPTION"
+4 DO DIR^ACRFDIC
+5 IF $DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+6 IF Y=""
QUIT
+7 IF '$DATA(ACR(Y))&'$DATA(ACR(1))
QUIT
+8 SET ACRDA=$SELECT(Y&$DATA(ACR(Y)):+ACR(Y),1:+ACR(1))
+9 IF Y>1
SET ACRDEL=+ACR(Y)_U_Y
+10 QUIT
ITEM5 SET DIR(0)="YO"
+1 SET DIR("A")="Add a "_$SELECT(ACRSEQ=1:"Secondary",1:"Tertiary ")_" Vendor"
+2 SET DIR("B")="NO"
+3 DO DIR^ACRFDIC
+4 IF Y'=1
SET ACRQUIT=""
QUIT
+5 SET DIC="^AUTTVNDR("
+6 SET DIC(0)="AEMQZ"
+7 SET DIC("A")="VENDOR..............: "
+8 DO DIC^ACRFDIC
+9 IF +Y<1!$DATA(ACRQUIT)!$DATA(ACROUT)
QUIT
+10 SET ACRVDA=+Y
SET ACR=0
+11 SET ACRSEQ=ACRSEQ+1
+12 SET X=ACRINDEX
+13 SET DIC(0)="L"
+14 SET DIC="^ACRITEM("
+15 SET DIC("DR")="24////"_ACRVDA_";26////"_ACRSEQ
+16 DO FILE^ACRFDIC
+17 IF +Y<1
QUIT
+18 SET (DA,ACRDA)=+Y
+19 SET $PIECE(^ACRITEM(+Y,0),U,2)=$PIECE(^ACRITEM(ACRDA(1),0),U,2)
+20 SET ^ACRITEM(+Y,"DT")=^ACRITEM(+ACRDA(1),"DT")
+21 SET DIK="^ACRITEM("
+22 DO IX1^ACRFDIC
+23 SET DA=+ACRDA
+24 SET DIE="^ACRITEM("
+25 SET DR=".03////"_ACRSEQ_";15////"_+ACRDA(1)_";26////"_ACRSEQ
+26 DO DIE^ACRFDIC
+27 SET (DA,ACRDA(ACRSEQ))=ACRDA
+28 SET DR="[ACR DI VENDOR]"
+29 DO ITEM311
+30 QUIT
ADD ;EP;TO ADD ITEM TO SI FILE DURING PO PROCESSING
+1 SET ACRADD=""
+2 SET ACRSSITM=""
+3 SET X=^ACRSS(ACRSSDA,0)
+4 SET ACRDT=$GET(^ACRSS(ACRSSDA,"DT"))
+5 SET ACRKW=$GET(^ACRSS(ACRSSDA,"NMS"))
+6 SET ACRVND=$GET(^ACRSS(ACRSSDA,"VND"))
+7 SET ACRDSC=$GET(^ACRSS(ACRSSDA,"DESC"))
+8 IF ACRDSC[";"
SET ACRDSC=$TRANSLATE(ACRDSC,";",",")
+9 SET DIC="^ACRITEM("
+10 SET DIC(0)="LZ"
+11 SET DIC("DR")=".02////"_$EXTRACT($PIECE(ACRKW,U,5),1,16)_";1////"_$PIECE(ACRDSC,U)_";2////"_$PIECE(ACRDSC,U,2)_";4////"_$PIECE(ACRDT,U,4)_";29////"_$PIECE(ACRDT,U,2)_";12////"_$PIECE(ACRDT,U,2)_";13////"_$PIECE(ACRDT,U,3)_";8////"_DT_";6////"_..
.
... $PIECE(X,U,4)
+12 SET DIC("DR")=DIC("DR")_";24////"_+ACRVND_";50////"_$PIECE(ACRDSC,U,3)_";51////"_$PIECE(ACRDSC,U,4)_";52////"_$PIECE(ACRDSC,U,5)
+13 DO NEW^ACRFSTK1
+14 DO ITEM11
+15 KILL ACRSSITM
+16 QUIT
