ACRFPITM ;IHS/OIRM/DSD/THL,AEF - DISPLAY VENDORS FOR A STOCK ITEM; [ 11/01/2001 9:44 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
;;ROUTINE TO DISPLAY VENDORS FOR A STOCK ITEM
EN D SET
D DISPLAY
EXIT S ACRSEQ=$S($D(ACR(3)):3,$D(ACR(2)):2,1:1)
S (ACR(1),ACRDA(1))=$S($D(ACR(1)):+ACR(1),1:+ACRDA)
K ACRVDA,ACRVCON,ACRVON,ACRVUI,ACRVUC,ACRVSP,ACRVNAM,ACRVEIN,ACRVCIT,ACRVPHN,ACRVA1,ACRVA2,ACRVA3,ACRVZIP,ACR11,ACR13,ACRDT1,ACRFOB,ACRBR,ACRCT,ACRDT,ACRMAN,ACRVNDC
Q
SET D PAUSE^ACRFWARN
W @IOF
W !?12,@ACRON,"VENDOR INFORMATION",@ACROF
W $$DASH^ACRFMENU
W !?11,"| PRIMARY"
W ?34,"| SECONDARY"
W ?57,"| TERTIARY"
W $$DASH^ACRFMENU
I '$O(^ACRITEM("G",D0,0)) D
.S DA=D0
.S DIE="^ACRITEM("
.S DR="15////"_D0
.D DIE^ACRFDIC
S ACR=0
F S ACR=$O(^ACRITEM("G",D0,ACR)) Q:'ACR D SET1
Q
SET1 S ACRDT=^ACRITEM(ACR,"DT")
S ACRDT1=$G(^ACRITEM(ACR,"DT1"))
S ACRSEQ=$P(ACRDT1,U,3)
I ACRSEQ="",'$O(^ACRITEM("G",D0,D0)) D
.S DA=D0
.S DIE="^ACRITEM("
.S DR="26////1"
.D DIE^ACRFDIC
S ACRVDA=$P(ACRDT1,U)
S ACRVCON=$P(ACRDT1,U,10)
S ACRVON=$P(ACRDT1,U,2)
S ACRVUI=$P(ACRDT1,U,6)
S ACRVUC=$P(ACRDT1,U,8)
S ACRVSP=$P(ACRDT1,U,7)
S ACRVNDC=$P(ACRDT1,U,4)
S ACRMAN=$P(ACRDT1,U,12)
S ACRBR=$P(ACRDT1,U,5)
S ACRCT=$E($P(ACRDT1,U,15),1,20)
S ACRE=$P(ACRDT1,U,16)
S Y=ACRE
S ACRFOB=""
X ^DD("DD")
S ACRE=Y
I ACRVCON,ACRVDA,ACRCT="",ACRE="",$D(^AUTTVNDR(ACRVDA,"CN",ACRVCON,0)) D I 1
.N X
.S X=^AUTTVNDR(ACRVDA,"CN",ACRVCON,0)
.S ACRVCON=$P(X,U)
.S ACRE=$P(X,U,3)
.S ACRFOB=$P(X,U,7)
.S ACRCT=$P(X,U,8)
.S Y=ACRE
.X ^DD("DD")
.S ACRE=Y
E S (ACRE,ACRVCON,ACRFOB,ACRCT)=""
S ACRVNAM=$E($P($G(^AUTTVNDR(+ACRVDA,0)),U),1,20)
S ACR11=$G(^AUTTVNDR(+ACRVDA,11))
S ACR13=$G(^AUTTVNDR(+ACRVDA,13))
S:ACRMAN]"" ACRMAN=$E($P(^ACRMAN(ACRMAN,0),U),1,22)
S ACRVEIN=$P(ACR11,U,13)
S ACRVPHN=$P(ACR11,U,9)
S ACRVA1=$E($P(ACR13,U),1,20)
S ACRVA2=$E($P(ACR13,U,2),1,20)
S ACRVCIT=$P(ACR13,U,3)
S ACRVZIP=$P(ACR13,U,4)
S:ACRVCIT ACRVCIT=$P(^DIC(5,ACRVCIT,0),U,2)
S ACRVA3=ACRVCIT_" "_ACRVZIP
S ACRVUI=$S(ACRVUI:$E($P(^ACRUI(ACRVUI,0),U,2),1,20),1:"**")
S:ACRSEQ ACR(ACRSEQ)=ACR_U_ACRVDA_U_ACRVNAM_U_ACRVA1_U_(ACRVA2)_U_(ACRVA3)_U_ACRVPHN_U_ACRVEIN_U_ACRVCON_U_ACRVON_U_ACRVUI_U_ACRVUC_U_ACRVSP_U_ACRE_U_ACRVNDC_U_ACRMAN_U_U_ACRFOB_U_ACRBR_U_ACRCT
Q
DISPLAY W !,"VENDOR"
W ?11,"|"
S ACRP=3
D W
W !," STREET"
W ?11,"|"
S ACRP=4
D W
W !," CITY"
W ?11,"|"
S ACRP=5
D W
W !," STATE/ZIP"
W ?11,"|"
S ACRP=6
D W
W !," PHONE"
W ?11,"|"
S ACRP=7
D W
W !," EIN"
W ?11,"|"
S ACRP=8
D W
W !,"CONTRACT #"
W ?11,"|"
S ACRP=9
D W
W !,"TERMS"
W ?11,"|"
S ACRP=20
D W
W !,"EXPIRES"
W ?11,"|"
S ACRP=14
D W
W !,"MANUFACTURE|"
S ACRP=16
D W
W !,"NDC"
W ?11,"|"
S ACRP=15
D W
W !,"VEN PROD #"
W ?11,"|"
S ACRP=10
D W
W !,"BIO RATING |"
S ACRP=19
D W
W !,"FOB"
W ?11,"|"
S ACRP=18
D W
W !,"PURCH U/I"
W ?11,"|"
S ACRP=11
D W
W !,"PURCH U/C"
W ?11,"|"
S ACRP=12
D W
W !,"PURCH S/P"
W ?11,"|"
S ACRP=13
D W
W !,"--------------------------------------------------------------------------------"
Q
W W:$D(ACR(1)) ?12,$P(ACR(1),U,ACRP)
W ?34,"|"
W:$D(ACR(2)) ?35,$P(ACR(2),U,ACRP)
W ?57,"|"
W:$D(ACR(3)) ?58,$P(ACR(3),U,ACRP)
Q
ACRFPITM ;IHS/OIRM/DSD/THL,AEF - DISPLAY VENDORS FOR A STOCK ITEM; [ 11/01/2001 9:44 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001
+2 ;;ROUTINE TO DISPLAY VENDORS FOR A STOCK ITEM
EN DO SET
+1 DO DISPLAY
EXIT SET ACRSEQ=$SELECT($DATA(ACR(3)):3,$DATA(ACR(2)):2,1:1)
+1 SET (ACR(1),ACRDA(1))=$SELECT($DATA(ACR(1)):+ACR(1),1:+ACRDA)
+2 KILL ACRVDA,ACRVCON,ACRVON,ACRVUI,ACRVUC,ACRVSP,ACRVNAM,ACRVEIN,ACRVCIT,ACRVPHN,ACRVA1,ACRVA2,ACRVA3,ACRVZIP,ACR11,ACR13,ACRDT1,ACRFOB,ACRBR,ACRCT,ACRDT,ACRMAN,ACRVNDC
+3 QUIT
SET DO PAUSE^ACRFWARN
+1 WRITE @IOF
+2 WRITE !?12,@ACRON,"VENDOR INFORMATION",@ACROF
+3 WRITE $$DASH^ACRFMENU
+4 WRITE !?11,"| PRIMARY"
+5 WRITE ?34,"| SECONDARY"
+6 WRITE ?57,"| TERTIARY"
+7 WRITE $$DASH^ACRFMENU
+8 IF '$ORDER(^ACRITEM("G",D0,0))
Begin DoDot:1
+9 SET DA=D0
+10 SET DIE="^ACRITEM("
+11 SET DR="15////"_D0
+12 DO DIE^ACRFDIC
End DoDot:1
+13 SET ACR=0
+14 FOR
SET ACR=$ORDER(^ACRITEM("G",D0,ACR))
IF 'ACR
QUIT
DO SET1
+15 QUIT
SET1 SET ACRDT=^ACRITEM(ACR,"DT")
+1 SET ACRDT1=$GET(^ACRITEM(ACR,"DT1"))
+2 SET ACRSEQ=$PIECE(ACRDT1,U,3)
+3 IF ACRSEQ=""
IF '$ORDER(^ACRITEM("G",D0,D0))
Begin DoDot:1
+4 SET DA=D0
+5 SET DIE="^ACRITEM("
+6 SET DR="26////1"
+7 DO DIE^ACRFDIC
End DoDot:1
+8 SET ACRVDA=$PIECE(ACRDT1,U)
+9 SET ACRVCON=$PIECE(ACRDT1,U,10)
+10 SET ACRVON=$PIECE(ACRDT1,U,2)
+11 SET ACRVUI=$PIECE(ACRDT1,U,6)
+12 SET ACRVUC=$PIECE(ACRDT1,U,8)
+13 SET ACRVSP=$PIECE(ACRDT1,U,7)
+14 SET ACRVNDC=$PIECE(ACRDT1,U,4)
+15 SET ACRMAN=$PIECE(ACRDT1,U,12)
+16 SET ACRBR=$PIECE(ACRDT1,U,5)
+17 SET ACRCT=$EXTRACT($PIECE(ACRDT1,U,15),1,20)
+18 SET ACRE=$PIECE(ACRDT1,U,16)
+19 SET Y=ACRE
+20 SET ACRFOB=""
+21 XECUTE ^DD("DD")
+22 SET ACRE=Y
+23 IF ACRVCON
IF ACRVDA
IF ACRCT=""
IF ACRE=""
IF $DATA(^AUTTVNDR(ACRVDA,"CN",ACRVCON,0))
Begin DoDot:1
+24 NEW X
+25 SET X=^AUTTVNDR(ACRVDA,"CN",ACRVCON,0)
+26 SET ACRVCON=$PIECE(X,U)
+27 SET ACRE=$PIECE(X,U,3)
+28 SET ACRFOB=$PIECE(X,U,7)
+29 SET ACRCT=$PIECE(X,U,8)
+30 SET Y=ACRE
+31 XECUTE ^DD("DD")
+32 SET ACRE=Y
End DoDot:1
IF 1
+33 IF '$TEST
SET (ACRE,ACRVCON,ACRFOB,ACRCT)=""
+34 SET ACRVNAM=$EXTRACT($PIECE($GET(^AUTTVNDR(+ACRVDA,0)),U),1,20)
+35 SET ACR11=$GET(^AUTTVNDR(+ACRVDA,11))
+36 SET ACR13=$GET(^AUTTVNDR(+ACRVDA,13))
+37 IF ACRMAN]""
SET ACRMAN=$EXTRACT($PIECE(^ACRMAN(ACRMAN,0),U),1,22)
+38 SET ACRVEIN=$PIECE(ACR11,U,13)
+39 SET ACRVPHN=$PIECE(ACR11,U,9)
+40 SET ACRVA1=$EXTRACT($PIECE(ACR13,U),1,20)
+41 SET ACRVA2=$EXTRACT($PIECE(ACR13,U,2),1,20)
+42 SET ACRVCIT=$PIECE(ACR13,U,3)
+43 SET ACRVZIP=$PIECE(ACR13,U,4)
+44 IF ACRVCIT
SET ACRVCIT=$PIECE(^DIC(5,ACRVCIT,0),U,2)
+45 SET ACRVA3=ACRVCIT_" "_ACRVZIP
+46 SET ACRVUI=$SELECT(ACRVUI:$EXTRACT($PIECE(^ACRUI(ACRVUI,0),U,2),1,20),1:"**")
+47 IF ACRSEQ
SET ACR(ACRSEQ)=ACR_U_ACRVDA_U_ACRVNAM_U_ACRVA1_U_(ACRVA2)_U_(ACRVA3)_U_ACRVPHN_U_ACRVEIN_U_ACRVCON_U_ACRVON_U_ACRVUI_U_ACRVUC_U_ACRVSP_U_ACRE_U_ACRVNDC_U_ACRMAN_U_U_ACRFOB_U_ACRBR_U_ACRCT
+48 QUIT
DISPLAY WRITE !,"VENDOR"
+1 WRITE ?11,"|"
+2 SET ACRP=3
+3 DO W
+4 WRITE !," STREET"
+5 WRITE ?11,"|"
+6 SET ACRP=4
+7 DO W
+8 WRITE !," CITY"
+9 WRITE ?11,"|"
+10 SET ACRP=5
+11 DO W
+12 WRITE !," STATE/ZIP"
+13 WRITE ?11,"|"
+14 SET ACRP=6
+15 DO W
+16 WRITE !," PHONE"
+17 WRITE ?11,"|"
+18 SET ACRP=7
+19 DO W
+20 WRITE !," EIN"
+21 WRITE ?11,"|"
+22 SET ACRP=8
+23 DO W
+24 WRITE !,"CONTRACT #"
+25 WRITE ?11,"|"
+26 SET ACRP=9
+27 DO W
+28 WRITE !,"TERMS"
+29 WRITE ?11,"|"
+30 SET ACRP=20
+31 DO W
+32 WRITE !,"EXPIRES"
+33 WRITE ?11,"|"
+34 SET ACRP=14
+35 DO W
+36 WRITE !,"MANUFACTURE|"
+37 SET ACRP=16
+38 DO W
+39 WRITE !,"NDC"
+40 WRITE ?11,"|"
+41 SET ACRP=15
+42 DO W
+43 WRITE !,"VEN PROD #"
+44 WRITE ?11,"|"
+45 SET ACRP=10
+46 DO W
+47 WRITE !,"BIO RATING |"
+48 SET ACRP=19
+49 DO W
+50 WRITE !,"FOB"
+51 WRITE ?11,"|"
+52 SET ACRP=18
+53 DO W
+54 WRITE !,"PURCH U/I"
+55 WRITE ?11,"|"
+56 SET ACRP=11
+57 DO W
+58 WRITE !,"PURCH U/C"
+59 WRITE ?11,"|"
+60 SET ACRP=12
+61 DO W
+62 WRITE !,"PURCH S/P"
+63 WRITE ?11,"|"
+64 SET ACRP=13
+65 DO W
+66 WRITE !,"--------------------------------------------------------------------------------"
+67 QUIT
W IF $DATA(ACR(1))
WRITE ?12,$PIECE(ACR(1),U,ACRP)
+1 WRITE ?34,"|"
+2 IF $DATA(ACR(2))
WRITE ?35,$PIECE(ACR(2),U,ACRP)
+3 WRITE ?57,"|"
+4 IF $DATA(ACR(3))
WRITE ?58,$PIECE(ACR(3),U,ACRP)
+5 QUIT
