A4A7PCH6.m

A4A7PCH6 ;SFISC/RWF - NEW PERSON PATCH 6 ;10/20/93  16:20

 ;;1.01;A4A7;**6**;JUL 30, 1992

A S U="^" D F200DD,F200A,PFP,F6DD,FE53X,F6XR Q

 ;

F200DD W !,"Remove the X-ref on DEA# and VA# in the New Person file."

 S DIK="^DD(200,53.2,1,",DA(2)=200,DA(1)=53.2,DA=1 D ^DIK

 S DIK="^DD(200,53.3,1,",DA(1)=53.3,DA=1 D ^DIK

 K ^VA(200,"APS1"),^VA(200,"APS2")

 W !,"Remove the 'BS' X-ref from the SSN field in NP."

 I $G(^DD(200,9,1,4,0))["200^BS" S DIK="^DD(200,9,1,",DA=4,DA(1)=9,DA(2)=200 D ^DIK K ^VA(200,"BS")

 W !,"Replace some X-ref in the New Person file."

 D ^A4A7P603,^A4A7P604

 D IX(200,.01),IX(200,8980.16),IX(200,53.2),IX(200,53.3),IX(200,53.4)

 Q

F200A W !,"Make the ALIAS field in file 200 avalable."

 K:$G(^DD(200,10,9))="^" ^DD(200,10,9)

 Q

PFP W !,"Fillin the PERSON FILE POINTER into file 200."

 W !,"Check and match DATE CREATED in file 200."

 F DA=.9:0 S DA=$O(^DIC(3,DA)) Q:DA'>0  D

 . S %=$P($G(^DIC(3,DA,0)),U,16),D3=$P($G(^DIC(3,DA,1)),U,7)

 . S:% $P(^VA(200,DA,0),U,16)=%

 . S D200=$P($G(^VA(200,DA,1)),U,7)

 . Q:D3=D200  S:(D3>0)&(D3'>D200) $P(^VA(200,DA,1),U,7)=D3

 . Q

 F DA=.9:0 S DA=$O(^DIC(16,DA)) Q:DA'>0  S %=$G(^DIC(16,DA,"A3")) I % S ^VA(200,"A16",DA,%)="" ;This may build more that a reindex.

 Q

F6DD W !,"Add X-refs to the provider file to keep file 200 in sync with it."

 D ^A4A7P601,^A4A7P602

 D IX(6,2),IX(6,3),IX(6,5),IX(6,6),IX(6,100)

 Q

FE53X W !,"Build the new X-ref on DEA# and VA#."

 F A4K7="53.2^1","53.3^1" S DIK="^VA(200,",DIK(1)=A4K7 D ENALL^DIK W "."

 Q

F6XR W !,"Now to update the NEW PERSON file with DEA,VA,TYPE,CLASS data from PROVIDER."

 F A4K7="2^1","3^1","5^2","6^2" S DIK="^DIC(6,",DIK(1)=A4K7 D ENALL^DIK W "."

 Q

IX(FILE,FIELD) W "."

 S DA(1)=FILE,DIK="^DD("_FILE_",",DA=FIELD D IX1^DIK

 Q

Q Q

A4A7PCH6  ;SFISC/RWF - NEW PERSON PATCH 6 ;10/20/93  16:20

 +1       ;;1.01;A4A7;**6**;JUL 30, 1992

A          SET U="^"

           DO F200DD

           DO F200A

           DO PFP

           DO F6DD

           DO FE53X

           DO F6XR

           QUIT 

 +1       ;

F200DD     WRITE !,"Remove the X-ref on DEA# and VA# in the New Person file."

 +1        SET DIK="^DD(200,53.2,1,"

           SET DA(2)=200

           SET DA(1)=53.2

           SET DA=1

           DO ^DIK

 +2        SET DIK="^DD(200,53.3,1,"

           SET DA(1)=53.3

           SET DA=1

           DO ^DIK

 +3        KILL ^VA(200,"APS1"),^VA(200,"APS2")

 +4        WRITE !,"Remove the 'BS' X-ref from the SSN field in NP."

 +5        IF $GET(^DD(200,9,1,4,0))["200^BS"

               SET DIK="^DD(200,9,1,"

               SET DA=4

               SET DA(1)=9

               SET DA(2)=200

               DO ^DIK

               KILL ^VA(200,"BS")

 +6        WRITE !,"Replace some X-ref in the New Person file."

 +7        DO ^A4A7P603

           DO ^A4A7P604

 +8        DO IX(200,.01)

           DO IX(200,8980.16)

           DO IX(200,53.2)

           DO IX(200,53.3)

           DO IX(200,53.4)

 +9        QUIT 

F200A      WRITE !,"Make the ALIAS field in file 200 avalable."

 +1        IF $GET(^DD(200,10,9))="^"

               KILL ^DD(200,10,9)

 +2        QUIT 

PFP        WRITE !,"Fillin the PERSON FILE POINTER into file 200."

 +1        WRITE !,"Check and match DATE CREATED in file 200."

 +2        FOR DA=.9:0

               SET DA=$ORDER(^DIC(3,DA))

               IF DA'>0

                   QUIT 

               Begin DoDot:1

 +3                SET %=$PIECE($GET(^DIC(3,DA,0)),U,16)

                   SET D3=$PIECE($GET(^DIC(3,DA,1)),U,7)

 +4                IF %

                       SET $PIECE(^VA(200,DA,0),U,16)=%

 +5                SET D200=$PIECE($GET(^VA(200,DA,1)),U,7)

 +6                IF D3=D200

                       QUIT 

                   IF (D3>0)&(D3'>D200)

                       SET $PIECE(^VA(200,DA,1),U,7)=D3

 +7                QUIT 

               End DoDot:1

 +8       ;This may build more that a reindex.

           FOR DA=.9:0

               SET DA=$ORDER(^DIC(16,DA))

               IF DA'>0

                   QUIT 

               SET %=$GET(^DIC(16,DA,"A3"))

               IF %

                   SET ^VA(200,"A16",DA,%)=""

 +9        QUIT 

F6DD       WRITE !,"Add X-refs to the provider file to keep file 200 in sync with it."

 +1        DO ^A4A7P601

           DO ^A4A7P602

 +2        DO IX(6,2)

           DO IX(6,3)

           DO IX(6,5)

           DO IX(6,6)

           DO IX(6,100)

 +3        QUIT 

FE53X      WRITE !,"Build the new X-ref on DEA# and VA#."

 +1        FOR A4K7="53.2^1","53.3^1"

               SET DIK="^VA(200,"

               SET DIK(1)=A4K7

               DO ENALL^DIK

               WRITE "."

 +2        QUIT 

F6XR       WRITE !,"Now to update the NEW PERSON file with DEA,VA,TYPE,CLASS data from PROVIDER."

 +1        FOR A4K7="2^1","3^1","5^2","6^2"

               SET DIK="^DIC(6,"

               SET DIK(1)=A4K7

               DO ENALL^DIK

               WRITE "."

 +2        QUIT 

IX(FILE,FIELD)  WRITE "."

 +1        SET DA(1)=FILE

           SET DIK="^DD("_FILE_","

           SET DA=FIELD

           DO IX1^DIK

 +2        QUIT 

Q          QUIT