Routine: ACHSTX44

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

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      ;

ACHSTX44.m