- ACHSWVEN ;IHS/OIT/LMH - BUILD CHS VENDOR DATA ;
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,15**;JUN 11,2001
- ;WEBFRS DATA EXTRACT ORIGINAL ROUTINE FR KEVIN ROGERS
- ;ACHS*3.1*14 IHS/OIT/LMH Brought into ACHS namespace Patch
- ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ ADDED TEST FOR ZIP+4 AND MAILING CITY AND STATE DEFINNED
- ;
- Q:'ACHSVDFN D
- .Q:$D(^AUTTVNDR(ACHSVDFN,0))'=1 S ACHS0=^(0)
- .S ACHSNAME=$P(ACHS0,"^")
- .;
- .;------------------- Node 11 -----------------------
- .;
- .S ACHSEIN="",ACHSEINS="",ACHSMPH="",ACHSRPH="",ACHSBPH="",ACHSPHON=""
- .S ACHSMFAX=""
- .I $D(^AUTTVNDR(ACHSVDFN,11))=1 S ACHS11=^(11) D
- ..S ACHSEIN=$P(ACHS11,"^"),ACHSEINS=$P(ACHS11,"^",2)
- ..S ACHSMPH=$P(ACHS11,"^",9),ACHSMFAX=$P(ACHS11,"^",14)
- .;
- .;-------------------Node 13 --------------------------
- .;
- .S (ACHSMAST,ACHSMAC,ACHSMSTA,ACHSMZIP,ACHSMPH)=""
- .S (ACHSBAST,ACHSBAC,ACHSBSTA,ACHSBZIP,ACHSBPH,ACHSBFAX)=""
- .I $D(^AUTTVNDR(ACHSVDFN,13))=1 S ACHS13=^(13) D
- ..S ACHSMAST=$P(ACHS13,"^"),ACHSMAC=$P(ACHS13,"^",2)
- ..S ACHSMSTA=$P(ACHS13,"^",3),ACHSMZIP=$P(ACHS13,"^",4)
- ..I +ACHSMSTA I $D(^DIC(5,+ACHSMSTA,0))=1 S ACHSMSTA=$P(^(0),"^",2)
- ..S ACHSBAST=$P(ACHS13,"^",6),ACHSBAC=$P(ACHS13,"^",7)
- ..S ACHSBSTA=$P(ACHS13,"^",8),ACHSBZIP=$P(ACHS13,"^",9)
- ..I +ACHSBSTA I $D(^DIC(5,+ACHSBSTA,0))=1 S ACHSBSTA=$P(^(0),"^",2)
- .;
- .;-----------------------Node 14 -------------------------
- .;
- .S (ACHSRAST,ACHSRAC,ACHSRSTA,ACHSRZIP,ACHSRPH,ACHSVFAX)=""
- .I $D(^AUTTVNDR(ACHSVDFN,14))=1 S ACHS14=^(14) D
- ..S ACHSRAST=$P(ACHS14,"^"),ACHSRAC=$P(ACHS14,"^",3)
- ..S ACHSRSTA=$P(ACHS14,"^",4),ACHSRZIP=$P(ACHS14,"^",5)
- ..I +ACHSRSTA I $D(^DIC(5,+ACHSRSTA,0))=1 S ACHSRSTA=$P(^(0),"^",2)
- ..S ACHSRPH=$P(ACHS14,"^",7),ACHSBPH=$P(ACHS14,"^",8)
- ..S ACHSBFAX=$P(ACHS14,"^",9),ACHSVFAX=$P(ACHS14,"^",10)
- .;
- .;--------------------- Build Data String --------------------
- .;
- .;VENDOR_ID^NAME^EIN^EIN_SUFFIX^MSTREET^MCITY^MSTATE^MZIP^
- .;MPHONE^MFAX^BSTREET^BCITY^BSTATE^BZIP^BPHONE^BFAX^RSTREET^RCITY^
- .;RSTATE^RZIP^RPHONE^RFAX"
- .;
- .S ACHSDATA=ASUFAC_ACHSVDFN_"^"_ACHSNAME_"^"_ACHSEIN_"^"_ACHSEINS_"^"
- .S ACHSDATA=ACHSDATA_ACHSMAST_"^"_ACHSMAC_"^"_ACHSMSTA_"^"_ACHSMZIP_"^"_ACHSMPH_"^"_ACHSMFAX_"^"
- .S ACHSDATA=ACHSDATA_ACHSBAST_"^"_ACHSBAC_"^"_ACHSBSTA_"^"_ACHSBZIP_"^"_ACHSBPH_"^"_ACHSBFAX_"^"
- .S ACHSDATA=ACHSDATA_ACHSRAST_"^"_ACHSRAC_"^"_ACHSRSTA_"^"_ACHSRZIP_"^"_ACHSRPH_"^"_ACHSVFAX
- .S:(ACHSMAC="")!(ACHSMSTA="") ACHSERR(7)=1 ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ
- .S X=$TR(ACHSMZIP,"-, ,:,,,","") S:X'?9N ACHSERR(8)=1 ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ
- .;
- K ACHSX,ACHS0,ACHSNAME,ACHSEIN,ACHSEINS
- K ACHSMAST,ACHSMAC,ACHSMSTA,ACHSMZIP,ACHSMPH,ACHSMFAX
- K ACHSBAST,ACHSBAC,ACHSBSTA,ACHSBZIP,ACHSBPH,ACHSBFAX
- K ACHSRAST,ACHSRAC,ACHSRSTA,ACHSRZIP,ACHSRPH,ACHSRFAX
- K ACHSPHON,ACHS11,ACHS14
- ACHSWVEN ;IHS/OIT/LMH - BUILD CHS VENDOR DATA ;
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**14,15**;JUN 11,2001
- +2 ;WEBFRS DATA EXTRACT ORIGINAL ROUTINE FR KEVIN ROGERS
- +3 ;ACHS*3.1*14 IHS/OIT/LMH Brought into ACHS namespace Patch
- +4 ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ ADDED TEST FOR ZIP+4 AND MAILING CITY AND STATE DEFINNED
- +5 ;
- +6 IF 'ACHSVDFN
- QUIT
- Begin DoDot:1
- +7 IF $DATA(^AUTTVNDR(ACHSVDFN,0))'=1
- QUIT
- SET ACHS0=^(0)
- +8 SET ACHSNAME=$PIECE(ACHS0,"^")
- +9 ;
- +10 ;------------------- Node 11 -----------------------
- +11 ;
- +12 SET ACHSEIN=""
- SET ACHSEINS=""
- SET ACHSMPH=""
- SET ACHSRPH=""
- SET ACHSBPH=""
- SET ACHSPHON=""
- +13 SET ACHSMFAX=""
- +14 IF $DATA(^AUTTVNDR(ACHSVDFN,11))=1
- SET ACHS11=^(11)
- Begin DoDot:2
- +15 SET ACHSEIN=$PIECE(ACHS11,"^")
- SET ACHSEINS=$PIECE(ACHS11,"^",2)
- +16 SET ACHSMPH=$PIECE(ACHS11,"^",9)
- SET ACHSMFAX=$PIECE(ACHS11,"^",14)
- End DoDot:2
- +17 ;
- +18 ;-------------------Node 13 --------------------------
- +19 ;
- +20 SET (ACHSMAST,ACHSMAC,ACHSMSTA,ACHSMZIP,ACHSMPH)=""
- +21 SET (ACHSBAST,ACHSBAC,ACHSBSTA,ACHSBZIP,ACHSBPH,ACHSBFAX)=""
- +22 IF $DATA(^AUTTVNDR(ACHSVDFN,13))=1
- SET ACHS13=^(13)
- Begin DoDot:2
- +23 SET ACHSMAST=$PIECE(ACHS13,"^")
- SET ACHSMAC=$PIECE(ACHS13,"^",2)
- +24 SET ACHSMSTA=$PIECE(ACHS13,"^",3)
- SET ACHSMZIP=$PIECE(ACHS13,"^",4)
- +25 IF +ACHSMSTA
- IF $DATA(^DIC(5,+ACHSMSTA,0))=1
- SET ACHSMSTA=$PIECE(^(0),"^",2)
- +26 SET ACHSBAST=$PIECE(ACHS13,"^",6)
- SET ACHSBAC=$PIECE(ACHS13,"^",7)
- +27 SET ACHSBSTA=$PIECE(ACHS13,"^",8)
- SET ACHSBZIP=$PIECE(ACHS13,"^",9)
- +28 IF +ACHSBSTA
- IF $DATA(^DIC(5,+ACHSBSTA,0))=1
- SET ACHSBSTA=$PIECE(^(0),"^",2)
- End DoDot:2
- +29 ;
- +30 ;-----------------------Node 14 -------------------------
- +31 ;
- +32 SET (ACHSRAST,ACHSRAC,ACHSRSTA,ACHSRZIP,ACHSRPH,ACHSVFAX)=""
- +33 IF $DATA(^AUTTVNDR(ACHSVDFN,14))=1
- SET ACHS14=^(14)
- Begin DoDot:2
- +34 SET ACHSRAST=$PIECE(ACHS14,"^")
- SET ACHSRAC=$PIECE(ACHS14,"^",3)
- +35 SET ACHSRSTA=$PIECE(ACHS14,"^",4)
- SET ACHSRZIP=$PIECE(ACHS14,"^",5)
- +36 IF +ACHSRSTA
- IF $DATA(^DIC(5,+ACHSRSTA,0))=1
- SET ACHSRSTA=$PIECE(^(0),"^",2)
- +37 SET ACHSRPH=$PIECE(ACHS14,"^",7)
- SET ACHSBPH=$PIECE(ACHS14,"^",8)
- +38 SET ACHSBFAX=$PIECE(ACHS14,"^",9)
- SET ACHSVFAX=$PIECE(ACHS14,"^",10)
- End DoDot:2
- +39 ;
- +40 ;--------------------- Build Data String --------------------
- +41 ;
- +42 ;VENDOR_ID^NAME^EIN^EIN_SUFFIX^MSTREET^MCITY^MSTATE^MZIP^
- +43 ;MPHONE^MFAX^BSTREET^BCITY^BSTATE^BZIP^BPHONE^BFAX^RSTREET^RCITY^
- +44 ;RSTATE^RZIP^RPHONE^RFAX"
- +45 ;
- +46 SET ACHSDATA=ASUFAC_ACHSVDFN_"^"_ACHSNAME_"^"_ACHSEIN_"^"_ACHSEINS_"^"
- +47 SET ACHSDATA=ACHSDATA_ACHSMAST_"^"_ACHSMAC_"^"_ACHSMSTA_"^"_ACHSMZIP_"^"_ACHSMPH_"^"_ACHSMFAX_"^"
- +48 SET ACHSDATA=ACHSDATA_ACHSBAST_"^"_ACHSBAC_"^"_ACHSBSTA_"^"_ACHSBZIP_"^"_ACHSBPH_"^"_ACHSBFAX_"^"
- +49 SET ACHSDATA=ACHSDATA_ACHSRAST_"^"_ACHSRAC_"^"_ACHSRSTA_"^"_ACHSRZIP_"^"_ACHSRPH_"^"_ACHSVFAX
- +50 ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ
- IF (ACHSMAC="")!(ACHSMSTA="")
- SET ACHSERR(7)=1
- +51 ;ACHS*3.1*15 2.11.2009 IHS/OIT/FCJ
- SET X=$TRANSLATE(ACHSMZIP,"-, ,:,,,","")
- IF X'?9N
- SET ACHSERR(8)=1
- +52 ;
- End DoDot:1
- +53 KILL ACHSX,ACHS0,ACHSNAME,ACHSEIN,ACHSEINS
- +54 KILL ACHSMAST,ACHSMAC,ACHSMSTA,ACHSMZIP,ACHSMPH,ACHSMFAX
- +55 KILL ACHSBAST,ACHSBAC,ACHSBSTA,ACHSBZIP,ACHSBPH,ACHSBFAX
- +56 KILL ACHSRAST,ACHSRAC,ACHSRSTA,ACHSRZIP,ACHSRPH,ACHSRFAX
- +57 KILL ACHSPHON,ACHS11,ACHS14
