ACHSTX44 ; IHS/ADC/GTH - EXPORT DATA (5/9) - RECORD 4(VENDOR FOR AO/FI) ;
;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
;
I 'ACHSF211,'ACHSF12 S REASON=11 Q
;
I VNDTXDT>VNDLUPD S RET=12 Q
;
B1A ;
S ACHSEIN=$E(VNDEIN_$J("",10),1,10)_$E(VNDEINSF_$J("",1,2))
S ACHSNAME=$E(VNDNAM_$J("",30),1,30)
S ACHSPTYP=$E(VNDTYPE_" ",1,2)
;
S ACHSFAC=$E(ACHSAFAC_$J("",6),1,6)
S X=$P(^AUTTVNDR(VNDPTR,11),U,7),X=$P(X,".")_$E($P(X,".",2)_"00",1,2),ACHSDAP=$E(X+10000000000,2,11)
;
S ACHSUPDT=$E(VNDLUPD,4,7)_$E(VNDLUPD,2,3),ACHSUPDT("CC")=$E(VNDLUPD+17000000,1,2)
I $L(ACHSUPDT)'=6 S ACHSUPDT=$J("",6),ACHSUPDT("CC")=$J("",2)
;
S X=""
F I=0:0 S I=$O(^AUTTVNDR(VNDPTR,"CN",I)) Q:'I I $P(^(I,0),U,2)'>DT,$P(^(0),U,3)>DT S X=$P(^(0),U)
S ACHSCN=$E(X_$J("",10),1,10)
;
S ACHSRCT=ACHSRCT+1,ACHSRTYP(4)=ACHSRTYP(4)+1,^ACHSTXVN(ACHSRCT)="4A"_ACHSEIN_ACHSNAME_ACHSPTYP_VNDFNFC_ACHSFAC_ACHSDAP_ACHSUPDT_ACHSCN_ACHSDEST
;
S PMFF=^ACHSTXVN(ACHSRCT) D ^ACHSTX99
;
I VNDSTATE'="" S ACHSST=$P(^DIC(5,VNDSTATE,0),U,2)
I VNDSTATE="" S ACHSST=" "
S ACHS1099=$S($P(^AUTTVNDR(VNDPTR,11),U,6)]"":$P(^(11),U,6),1:" ")
S X=$P(^AUTTVNDR(VNDPTR,11),U,9)
F ACHS=1:1:$L(X) Q:ACHS>$L(X) I $E(X,ACHS)'?1N S X=$E(X,1,ACHS-1)_$E(X,ACHS+1,99),ACHS=ACHS-1
S X=$E(X,1,10),X=$J(X,10),ACHSFONE=X,X=$P(^AUTTSITE(1,0),U,2),ACHSAPN=$S($L(X)<1!($L(X)>2):" ",$L(X)=1:" "_X,1:X)
S ACHSRCT=ACHSRCT+1
;
S ^ACHSTXVN(ACHSRCT)="4B"_$S($D(^AUTTVNDR(VNDPTR,13)):$E($P(^AUTTVNDR(VNDPTR,13),U)_$J("",30),1,30),1:"")
S ^ACHSTXVN(ACHSRCT)=^ACHSTXVN(ACHSRCT)_$S($D(^AUTTVNDR(VNDPTR,13)):$E($P(^AUTTVNDR(VNDPTR,13),U,2)_$J("",20),1,20),1:"")
S ^ACHSTXVN(ACHSRCT)=^ACHSTXVN(ACHSRCT)_ACHSST_$S($D(^AUTTVNDR(VNDPTR,13)):$E($P(^AUTTVNDR(VNDPTR,13),U,4)_$J("",9),1,9),1:"")_ACHS1099_ACHSFONE_ACHSAPN_ACHSUPDT("CC")_" "_ACHSDEST
;
S PMFF=^ACHSTXVN(ACHSRCT) D ^ACHSTX99
;
S ACHSRTYP(4)=ACHSRTYP(4)+1
; Update CHS TX DATE in VENDOR.
D EDITVNDR^ACHSVDVA(VNDPTR,"1112///"_DT)
S RET=0
Q
;
ACHSTX44 ; IHS/ADC/GTH - EXPORT DATA (5/9) - RECORD 4(VENDOR FOR AO/FI) ;
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;;JUN 11, 2001
+2 ;
+3 IF 'ACHSF211
IF 'ACHSF12
SET REASON=11
QUIT
+4 ;
+5 IF VNDTXDT>VNDLUPD
SET RET=12
QUIT
+6 ;
B1A ;
+1 SET ACHSEIN=$EXTRACT(VNDEIN_$JUSTIFY("",10),1,10)_$EXTRACT(VNDEINSF_$JUSTIFY("",1,2))
+2 SET ACHSNAME=$EXTRACT(VNDNAM_$JUSTIFY("",30),1,30)
+3 SET ACHSPTYP=$EXTRACT(VNDTYPE_" ",1,2)
+4 ;
+5 SET ACHSFAC=$EXTRACT(ACHSAFAC_$JUSTIFY("",6),1,6)
+6 SET X=$PIECE(^AUTTVNDR(VNDPTR,11),U,7)
SET X=$PIECE(X,".")_$EXTRACT($PIECE(X,".",2)_"00",1,2)
SET ACHSDAP=$EXTRACT(X+10000000000,2,11)
+7 ;
+8 SET ACHSUPDT=$EXTRACT(VNDLUPD,4,7)_$EXTRACT(VNDLUPD,2,3)
SET ACHSUPDT("CC")=$EXTRACT(VNDLUPD+17000000,1,2)
+9 IF $LENGTH(ACHSUPDT)'=6
SET ACHSUPDT=$JUSTIFY("",6)
SET ACHSUPDT("CC")=$JUSTIFY("",2)
+10 ;
+11 SET X=""
+12 FOR I=0:0
SET I=$ORDER(^AUTTVNDR(VNDPTR,"CN",I))
IF 'I
QUIT
IF $PIECE(^(I,0),U,2)'>DT
IF $PIECE(^(0),U,3)>DT
SET X=$PIECE(^(0),U)
+13 SET ACHSCN=$EXTRACT(X_$JUSTIFY("",10),1,10)
+14 ;
+15 SET ACHSRCT=ACHSRCT+1
SET ACHSRTYP(4)=ACHSRTYP(4)+1
SET ^ACHSTXVN(ACHSRCT)="4A"_ACHSEIN_ACHSNAME_ACHSPTYP_VNDFNFC_ACHSFAC_ACHSDAP_ACHSUPDT_ACHSCN_ACHSDEST
+16 ;
+17 SET PMFF=^ACHSTXVN(ACHSRCT)
DO ^ACHSTX99
+18 ;
+19 IF VNDSTATE'=""
SET ACHSST=$PIECE(^DIC(5,VNDSTATE,0),U,2)
+20 IF VNDSTATE=""
SET ACHSST=" "
+21 SET ACHS1099=$SELECT($PIECE(^AUTTVNDR(VNDPTR,11),U,6)]"":$PIECE(^(11),U,6),1:" ")
+22 SET X=$PIECE(^AUTTVNDR(VNDPTR,11),U,9)
+23 FOR ACHS=1:1:$LENGTH(X)
IF ACHS>$LENGTH(X)
QUIT
IF $EXTRACT(X,ACHS)'?1N
SET X=$EXTRACT(X,1,ACHS-1)_$EXTRACT(X,ACHS+1,99)
SET ACHS=ACHS-1
+24 SET X=$EXTRACT(X,1,10)
SET X=$JUSTIFY(X,10)
SET ACHSFONE=X
SET X=$PIECE(^AUTTSITE(1,0),U,2)
SET ACHSAPN=$SELECT($LENGTH(X)<1!($LENGTH(X)>2):" ",$LENGTH(X)=1:" "_X,1:X)
+25 SET ACHSRCT=ACHSRCT+1
+26 ;
+27 SET ^ACHSTXVN(ACHSRCT)="4B"_$SELECT($DATA(^AUTTVNDR(VNDPTR,13)):$EXTRACT($PIECE(^AUTTVNDR(VNDPTR,13),U)_$JUSTIFY("",30),1,30),1:"")
+28 SET ^ACHSTXVN(ACHSRCT)=^ACHSTXVN(ACHSRCT)_$SELECT($DATA(^AUTTVNDR(VNDPTR,13)):$EXTRACT($PIECE(^AUTTVNDR(VNDPTR,13),U,2)_$JUSTIFY("",20),1,20),1:"")
+29 SET ^ACHSTXVN(ACHSRCT)=^ACHSTXVN(ACHSRCT)_ACHSST_$SELECT($DATA(^AUTTVNDR(VNDPTR,13)):$EXTRACT($PIECE(^AUTTVNDR(VNDPTR,13),U,4)_$JUSTIFY("",9),1,9),1:"")_ACHS1099_ACHSFONE_ACHSAPN_ACHSUPDT("CC")_" "_ACHSDEST
+30 ;
+31 SET PMFF=^ACHSTXVN(ACHSRCT)
DO ^ACHSTX99
+32 ;
+33 SET ACHSRTYP(4)=ACHSRTYP(4)+1
+34 ; Update CHS TX DATE in VENDOR.
+35 DO EDITVNDR^ACHSVDVA(VNDPTR,"1112///"_DT)
+36 SET RET=0
+37 QUIT
+38 ;
