Routine: ACRFPITM

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

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

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

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 !,"--------------------------------------------------------------------------------"

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)

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

ACRFPITM.m