ACHSDM.m

ACHSDM ;IHS/OIT/FCJ - FX MEDICAID ENTRIES ; 02/19/2015

 ;;99.1;IHS DICTIONARIES (PATIENT);**24**;MAR 9, 1999;Build 1

 ;Fix developed for BMW

 ;DFN's in the Medicaid file were not dinumed this routine will

 ;be ran during the clean up of those entries

 ;

 ;CALLED BY AUPNMCDF

EN(DFN,ACHSMCD,ACHSOLD,ACHSNEW) ; EP - MCD ELIGIBILITY FIX

 ;DFN-PATIENT DFN

 ;ACHSMCD-MEDICAID IEN

 ;ACHSOLD-OLD MEDICAID IEN

 ;ACHSNEW-NEW MEDICAID IEN

 ;

 ;

 S ACHSDFC=0

 F  S ACHSDFC=$O(^ACHSDEN(ACHSDFC)) Q:ACHSDFC'?1N.N  D

 .Q:'$D(^ACHSDEN(ACHSDFC,"D","D",DFN))

 .S ACHSDDFN=0

 .F  S ACHSDDFN=$O(^ACHSDEN(ACHSDFC,"D","D",DFN,ACHSDDFN)) Q:ACHSDDFN'?1N.N  D

 ..Q:'$D(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320))

 ..S ACHSDINS=0

 ..F  S ACHSDINS=$O(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS)) Q:ACHSDINS'?1N.N  D

 ...Q:$P(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,2)'="C"

 ...Q:$P(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,3)'=ACHSMCD

 ...Q:$P(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,4)'=ACHSOLD

 ...S $P(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,4)=ACHSNEW

 ...;D LOG^AUPNMCDF(FILE,IEN UPDATED,FIELD #,OLD VALUE)

 ...S ACHSIEN=ACHSDINS_","_ACHSDDFN_","_ACHSDFC,ACHSFLD="9002071.13,3",ACHSFL=9002071

 ...D LOG^AUPNMCDF(ACHSFL,ACHSIEN,ACHSFLD,ACHSOLD)

 ;

EXT ;

 K ACHSDFC,ACHSDDFN,ACHSDINS,ACHSMCD,ACHSOLD,ACHSNEW,ACHSIEN,ACHSFLD,ACHSFL

 Q

 ;

ACHSDM    ;IHS/OIT/FCJ - FX MEDICAID ENTRIES ; 02/19/2015

 +1       ;;99.1;IHS DICTIONARIES (PATIENT);**24**;MAR 9, 1999;Build 1

 +2       ;Fix developed for BMW

 +3       ;DFN's in the Medicaid file were not dinumed this routine will

 +4       ;be ran during the clean up of those entries

 +5       ;

 +6       ;CALLED BY AUPNMCDF

EN(DFN,ACHSMCD,ACHSOLD,ACHSNEW) ; EP - MCD ELIGIBILITY FIX

 +1       ;DFN-PATIENT DFN

 +2       ;ACHSMCD-MEDICAID IEN

 +3       ;ACHSOLD-OLD MEDICAID IEN

 +4       ;ACHSNEW-NEW MEDICAID IEN

 +5       ;

 +6       ;

 +7        SET ACHSDFC=0

 +8        FOR 

               SET ACHSDFC=$ORDER(^ACHSDEN(ACHSDFC))

               IF ACHSDFC'?1N.N

                   QUIT 

               Begin DoDot:1

 +9                IF '$DATA(^ACHSDEN(ACHSDFC,"D","D",DFN))

                       QUIT 

 +10               SET ACHSDDFN=0

 +11               FOR 

                       SET ACHSDDFN=$ORDER(^ACHSDEN(ACHSDFC,"D","D",DFN,ACHSDDFN))

                       IF ACHSDDFN'?1N.N

                           QUIT 

                       Begin DoDot:2

 +12                       IF '$DATA(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320))

                               QUIT 

 +13                       SET ACHSDINS=0

 +14                       FOR 

                               SET ACHSDINS=$ORDER(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS))

                               IF ACHSDINS'?1N.N

                                   QUIT 

                               Begin DoDot:3

 +15                               IF $PIECE(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,2)'="C"

                                       QUIT 

 +16                               IF $PIECE(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,3)'=ACHSMCD

                                       QUIT 

 +17                               IF $PIECE(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,4)'=ACHSOLD

                                       QUIT 

 +18                               SET $PIECE(^ACHSDEN(ACHSDFC,"D",ACHSDDFN,320,ACHSDINS,0),U,4)=ACHSNEW

 +19      ;D LOG^AUPNMCDF(FILE,IEN UPDATED,FIELD #,OLD VALUE)

 +20                               SET ACHSIEN=ACHSDINS_","_ACHSDDFN_","_ACHSDFC

                                   SET ACHSFLD="9002071.13,3"

                                   SET ACHSFL=9002071

 +21                               DO LOG^AUPNMCDF(ACHSFL,ACHSIEN,ACHSFLD,ACHSOLD)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +22      ;

EXT       ;

 +1        KILL ACHSDFC,ACHSDDFN,ACHSDINS,ACHSMCD,ACHSOLD,ACHSNEW,ACHSIEN,ACHSFLD,ACHSFL

 +2        QUIT 

 +3       ;