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
