209 lines
5.8 KiB
Mathematica
209 lines
5.8 KiB
Mathematica
PRCHID ;WISC/DJM/BGJ-VENDOR IDENTIFIER DATA ;5/3/99 1:11pm
|
|
V ;;5.1;IFCAP;**7**;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
START ;DISPLAY IDENTIFYING DATA FROM RECORD IN FILE 440
|
|
N LN0,LN2,LN3,LN7,LN9,LN10,PHONE,PH,A,T,T1,NO,ADDR1,FMS,CITY,STATE
|
|
N ZIP,ADDR2,CODE,FAX,FX,RV,IVCK,PRCFD,BTMSG
|
|
;
|
|
; FIND OUT WHAT OPTION USER IS IN NOW. IF OPTION BEGINS WITH 'PRCF'
|
|
; RECORD FACT THAT OPTION IS A 'FISCAL' OPTION.
|
|
;
|
|
D OP^XQCHK
|
|
I XQOPT'=-1,($E(XQOPT,1,4)="PRCF") S PRCFD("PAY")=1
|
|
;
|
|
;GET CURRENT RECORD NODES NEEDED TO DISPLAY IDENTIFIERS
|
|
;
|
|
S IEN=+Y
|
|
S LN0=$G(^PRC(440,IEN,0))
|
|
S LN2=$G(^PRC(440,IEN,2))
|
|
S LN3=$G(^PRC(440,IEN,3))
|
|
S LN7=$G(^PRC(440,IEN,7))
|
|
S LN9=$G(^PRC(440,IEN,9))
|
|
S LN10=$G(^PRC(440,IEN,10))
|
|
S PRCFLAG=""
|
|
;
|
|
;DISPLAY ADDITIONAL DATA ON LINE WITH VENDOR NAME IF VENDOR
|
|
;IS INACTIVATED.
|
|
;
|
|
I $P(LN10,U,5)=1 G IEN
|
|
;
|
|
;DISPLAY ADDITIONAL DATA ON LINE WITH VENDOR NAME IF VENDOR
|
|
;IS NOT INACTIVATED.
|
|
;
|
|
I $P(LN3,U,2)="Y" D EN^DDIOL("EDI","","?49")
|
|
S PHONE="PH:"
|
|
S PH=$P(LN0,U,10)
|
|
D PHONE
|
|
S PHONE=PHONE_PH
|
|
D EN^DDIOL(PHONE,"","?54")
|
|
;
|
|
;COME HERE TO DISPLAY THE RECORD'S INTERNAL ENTRY NUMBER
|
|
;
|
|
IEN S NO=" "_IEN
|
|
S NO="NO:"_$E(NO,$L(NO)-5,99)
|
|
D EN^DDIOL(NO,"","?71")
|
|
;
|
|
;NOW DISPLAY ORDERING ADDRESS DATA IN IDENTIFIERS
|
|
;
|
|
I '$D(PRCFD("PAY")) D
|
|
. ;
|
|
. ;FIRST ORDERING ADDRESS LINE
|
|
. ;
|
|
. S ADDR1="ORD ADD:"_$P(LN0,U,2)
|
|
. D EN^DDIOL(ADDR1,"","!")
|
|
. S FMS="FMS:"_$P(LN3,U,7)
|
|
. D EN^DDIOL(FMS,"","?46")
|
|
. ;
|
|
. ;SECOND ORDERING ADDRESS LINE
|
|
. ;
|
|
. S CITY=$P(LN0,U,6)
|
|
. S STATE=$P(LN0,U,7)
|
|
. I STATE>0 D
|
|
. . S STATE=$P($G(^DIC(5,STATE,0)),U,2)
|
|
. S ZIP=$P(LN0,U,8)
|
|
. I ZIP?9N S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,9)
|
|
. S ADDR2=""
|
|
. I CITY]"",STATE]"" S ADDR2=ADDR2_CITY_", "_STATE
|
|
. I CITY="",STATE]"" S ADDR2=ADDR2_STATE
|
|
. I CITY]"",STATE="" S ADDR2=ADDR2_CITY
|
|
. S:ADDR2]"" ADDR2=ADDR2_" "_ZIP
|
|
. S:ADDR2="" ADDR2=ADDR2_ZIP
|
|
. D EN^DDIOL(ADDR2,"","!?8")
|
|
. S CODE="CODE:"_$P(LN3,U,4)_$P(LN3,U,5)
|
|
. D EN^DDIOL(CODE,"","?46")
|
|
. S FAX="FAX:"
|
|
. K PH
|
|
. S PH=$P(LN10,U,6)
|
|
. D PHONE
|
|
. S FAX=FAX_PH
|
|
. D EN^DDIOL(FAX,"","?64")
|
|
;
|
|
;END OF ORDERING ADDRESS LINES
|
|
;
|
|
;SHOW PAYMENT ADDRESS LINES
|
|
;
|
|
I $D(PRCFD("PAY")) D
|
|
. ;
|
|
. ;FIRST PAYMENT ADDRESS LINE
|
|
. ;
|
|
. S ADDR1="PAY ADD:"_$P(LN7,U,3)
|
|
. D EN^DDIOL(ADDR1,"","!")
|
|
. S FMS="FMS:"_$P(LN3,U,7)
|
|
. D EN^DDIOL(FMS,"","?46")
|
|
. ;
|
|
. ;SECOND PAYMENT ADDRESS LINE
|
|
. ;
|
|
. S CITY=$P(LN7,U,7)
|
|
. S STATE=$P(LN7,U,8)
|
|
. I STATE>0 D
|
|
. . S STATE=$P($G(^DIC(5,STATE,0)),U,2)
|
|
. S ZIP=$P(LN7,U,9)
|
|
. I ZIP?9N S ZIP=$E(ZIP,1,5)_"-"_$E(ZIP,6,9)
|
|
. S ADDR2=""
|
|
. I CITY]"",STATE]"" S ADDR2=ADDR2_CITY_", "_STATE
|
|
. I CITY="",STATE]"" S ADDR2=ADDR2_STATE
|
|
. I CITY]"",STATE="" S ADDR2=ADDR2_CITY
|
|
. S:ADDR2]"" ADDR2=ADDR2_" "_ZIP
|
|
. S:ADDR2="" ADDR2=ADDR2_ZIP
|
|
. D EN^DDIOL(ADDR2,"","!?8")
|
|
. S CODE="CODE:"_$P(LN3,U,4)_$P(LN3,U,5)
|
|
. D EN^DDIOL(CODE,"","?46")
|
|
. S FAX="FAX:"
|
|
. K PH
|
|
. S PH=$P(LN10,U,6)
|
|
. D PHONE
|
|
. S FAX=FAX_PH
|
|
. D EN^DDIOL(FAX,"","?64")
|
|
. Q
|
|
;
|
|
;END OF PAYMENT ADDRESS LINES
|
|
;
|
|
;LETS INFORM USER IF THIS VENDOR IS INACTIVATED
|
|
;
|
|
D EN^DDIOL("","","!")
|
|
I $P(LN10,U,5)=1 D
|
|
. D EN^DDIOL("****THIS VENDOR IS INACTIVE","","?0")
|
|
. ;
|
|
. ;NOW SEE IF WE CAN FIND A SUBSTITUTE VENDOR
|
|
. ;
|
|
. ;RV = REPLACEMENT VENDOR INTERNAL ENTRY NUMBER
|
|
. ;IVCK = INACTIVATED VENDOR CHECK
|
|
. ;
|
|
. S LOOP=""
|
|
. S RV=+LN9
|
|
. I RV=0&($E(LN0,1,2)["**") D
|
|
. . D EN^DDIOL(", NO REPLACEMENT VENDOR *****","","?27")
|
|
. . S PRCFLAG=1 W !,?5," PLEASE CHOOSE ANOTHER VENDOR " Q
|
|
. ;
|
|
. ;STOP IF A REPLACEMENT VENDOR POINTS TO ITSELF
|
|
. ;
|
|
. I RV=IEN S RV=0
|
|
. F Q:RV=0 S IVCK=$P($G(^PRC(440,RV,10)),U,5) Q:IVCK="" D Q:LOOP=1
|
|
. . S RVX=+$G(^PRC(440,RV,9))
|
|
. . I RVX'>0 S LOOP=1 Q
|
|
. . I RV=RVX S LOOP=1 Q
|
|
. . S RV=RVX
|
|
. . I RV=0!(LOOP=1) D EN^DDIOL("****","","?27") Q
|
|
. I RV>0 D
|
|
. . S RVX=RV
|
|
. . S RV=" "_RV
|
|
. . S RV=$E(RV,$L(RV)-5,99)
|
|
. . D EN^DDIOL(", USE VENDOR NO:"_RV_"****","","?27")
|
|
. . S PRCFLAG=1,LN0=$G(^PRC(440,RVX,0)),NAME=$P(LN0,U,1)
|
|
. . W !,?5," VENDOR NAME "_NAME Q
|
|
. ;
|
|
. Q
|
|
;
|
|
;ONLY IF VENDER IS ACTIVE & THIS VENDOR LOOKUP IS NOT COMING FROM
|
|
;A FISCAL OPTION DISPLAY 'BUSINESS TYPE' SETUP
|
|
;
|
|
I $P(LN10,U,5)="",'$D(PRCFD("PAY")) D
|
|
. D SETBTMSG
|
|
. I $P(LN0,U,11)]"" Q
|
|
. I LN2="" D EN^DDIOL(.BTMSG) Q
|
|
. I $P(LN2,U,2)]"" Q
|
|
. I $P(LN2,U,3)']"" D EN^DDIOL(.BTMSG) Q
|
|
;
|
|
;IF VENDOR IS INACTIVE DISPLAY 'EDI VENDOR'
|
|
;
|
|
I $P(LN10,U,5)=1 D
|
|
. I $P(LN3,U,2)="Y" D EN^DDIOL("EDI VENDOR","","?56") Q
|
|
EXIT Q
|
|
;
|
|
PHONE ; PHONE/FAX FORMATTING
|
|
;
|
|
S PH=$TR(PH,"abcdefghijklmnoprstuvwxy","222333444555666777888999")
|
|
S PH=$TR(PH,"ABCDEFGHIJKLMNOPRSTUVWXY","222333444555666777888999")
|
|
I PH]"" D
|
|
. I PH'?.N D Q
|
|
. . S A=1
|
|
. . F S T=$E(PH,1) D:T?1N S:T'?1N PH=$E(PH,2,99) Q:PH=""
|
|
. . . S PH(A)=""
|
|
. . . F S T1=$E(PH,1) Q:T1'?1N S PH(A)=PH(A)_T1,PH=$E(PH,2,99) Q:PH=""
|
|
. . . Q:PH=""
|
|
. . . S A=A+1
|
|
. . . Q
|
|
. . I $G(PH(1))="011" S PH="INTERN'L" Q
|
|
. . I $L($G(PH(1)))=1,$L($G(PH(2)))=3,$L($G(PH(3)))=3,$L($G(PH(4)))=4 S PH=PH(2)_"-"_PH(3)_"-"_PH(4) Q
|
|
. . I $L($G(PH(1)))=3,$L($G(PH(2)))=3,$L($G(PH(3)))=4 S PH=PH(1)_" "_PH(2)_"-"_PH(3) Q
|
|
. . I $L($G(PH(1)))=3,$L($G(PH(2)))=4 S PH=" "_PH(1)_"-"_PH(2) Q
|
|
. . Q
|
|
. I $L(PH)>9 S PH=$E(PH,1,3)_" "_$E(PH,4,6)_"-"_$E(PH,7,10) Q
|
|
. I $L(PH)>6 S PH=" "_$E(PH,1,3)_"-"_$E(PH,4,7) Q
|
|
. Q
|
|
Q
|
|
SETBTMSG ;SET ARRAY TO HOLD VENDOR BUSINESS TYPE FIELD MESSAGE
|
|
S BTMSG(1)="*** BUSINESS TYPE UNDEFINED ***"
|
|
S BTMSG(1,"F")="$C(7),!"
|
|
;
|
|
;IF NOT ENTERING A PURCHASE ORDER, DON'T DISPLAY REMAINDER OF MSG
|
|
;
|
|
I '$D(PRCHPO) S BTMSG(2)="",BTMSG(2,"F")="!" Q
|
|
S BTMSG(2)="You will not be able to complete this Purchase Order"
|
|
S BTMSG(2,"F")="!"
|
|
S BTMSG(3)="with this vendor until the BUSINESS TYPE is defined"
|
|
S BTMSG(3,"F")="$C(7),!"
|
|
S BTMSG(4)=""
|
|
S BTMSG(4,"F")="!"
|
|
Q
|