ACHSIC2.m

ACHSIC2 ;IHS/ITSC/FCJ-SET UP ICD ERROR GLOBAL for FI Sites only

 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22,23**;JUN 11, 2001;Build 43

 ;NEW ROUTINE FOR INSTALL TO SET THE ICD GLOBALS

 ;

 Q

SET ;SET ICD TMP FILE

 ;TEST FOR ICD CODES WITH LENGTH OF 3

 ;ICD=CODE IT SHOULD BE

 ;$$ICDDX^ICDCODE(ICD2)=WHAT IT IS GETTING SET TO

 ;ICD2 IS THE IEN OF THE INCORRECT ICD AND WHAT IS SET IN ACHS

 ;

 D ICD

 D DOCS

 Q

ICD ;CHECK ICD CODES

 I $D(^ACHSICD9(0)) W !,"ICD9 Data already set, routine will not be ran." Q

 W !,"Setting ICD Temporary global"

 S X=0,CT=0,CT1=0

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

 .S CT=CT+1,ICD=$P(^ICD9(X,0),U)

 .I (ICD="41.3")!(ICD="41.86")!(ICD="8.65")!(ICD=488)!(ICD=449)!(ICD=538) D ADD

 .I $L($P(^ICD9(X,0),U))=4 D

 ..Q:$E(ICD,1,3)'?3N

 ..I ($E(ICD,4)?1".")&($E(ICD,1)'=0) D ADD

 Q

ADD ;ADD ICD CODE TO FILE

 ;S ICD2=$E(ICD,1,3),^ACHSICD9(X)=ICD_"^"_$$ICDDX^ICDCODE(ICD2),CT1=CT1+1 ;ACHS*3.1*23

 S ICD2=$E(ICD,1,3),^ACHSICD9(X)=ICD_"^"_$$ICDDX^ICDEX(ICD2),CT1=CT1+1   ;ACHS*3.1*23

 S ^ACHSICD9("B",ICD2,X)=""

 S ^ACHSICD9(0)=CT1

 W "."

 ;W !,CT1,". ",ICD_"^"_$$ICDDX^ICDCODE(ICD2)

 Q

DOCS ;SET CHS RECORD in the temporary file WITH POSSIBLE ERRORS, START W/PAY DOCS FR 9-1-2010

 W !,"Setting the PO document global"

 S L=0 F  S L=$O(^ACHSF("B",L)) Q:L'?1N.N  D

 .;I $P(^ACHSF(L,2),U,11)'="Y" W !,"Facility is not an FI site, routine will not be ran for ",$P(^DIC(4,DUZ(2),0),U) Q

 .S ACHSPAY=3100900,CT=0

 .F  S ACHSPAY=$O(^ACHSF(L,"TB",ACHSPAY)) Q:ACHSPAY'?1N.N  F TYP="P","IP" D

 ..S L1=0 F  S L1=$O(^ACHSF(L,"TB",ACHSPAY,TYP,L1)) Q:L1'?1N.N  D

 ...Q:'$D(^ACHSF(L,"D",L1,9,0))

 ...Q:$D(^ACHSICD(L,"D",L1,0))

 ...S L2=0 F  S L2=$O(^ACHSF(L,"D",L1,9,L2)) Q:L2'?1N.N  D

 ....S ICD2=$P(^ACHSF(L,"D",L1,9,L2,0),U)

 ....I $D(^ACHSICD9("B",ICD2)) D	

 .....S CT=CT+1 W "."

 .....S ^ACHSICD(L,"D",L1,0)=^ACHSF(L,"D",L1,0)

 .....S ^ACHSICD(L,"D",L1,9,L2,0)=^ACHSF(L,"D",L1,9,L2,0)

 .....S ^ACHSICD("E",ICD2,L1)=""

 ....S ^ACHSICD(L,"D",0)=CT

 Q

ACHSIC2   ;IHS/ITSC/FCJ-SET UP ICD ERROR GLOBAL for FI Sites only

 +1       ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**22,23**;JUN 11, 2001;Build 43

 +2       ;NEW ROUTINE FOR INSTALL TO SET THE ICD GLOBALS

 +3       ;

 +4        QUIT 

SET       ;SET ICD TMP FILE

 +1       ;TEST FOR ICD CODES WITH LENGTH OF 3

 +2       ;ICD=CODE IT SHOULD BE

 +3       ;$$ICDDX^ICDCODE(ICD2)=WHAT IT IS GETTING SET TO

 +4       ;ICD2 IS THE IEN OF THE INCORRECT ICD AND WHAT IS SET IN ACHS

 +5       ;

 +6        DO ICD

 +7        DO DOCS

 +8        QUIT 

ICD       ;CHECK ICD CODES

 +1        IF $DATA(^ACHSICD9(0))

               WRITE !,"ICD9 Data already set, routine will not be ran."

               QUIT 

 +2        WRITE !,"Setting ICD Temporary global"

 +3        SET X=0

           SET CT=0

           SET CT1=0

 +4        FOR 

               SET X=$ORDER(^ICD9(X))

               IF X'?1N.N

                   QUIT 

               Begin DoDot:1

 +5                SET CT=CT+1

                   SET ICD=$PIECE(^ICD9(X,0),U)

 +6                IF (ICD="41.3")!(ICD="41.86")!(ICD="8.65")!(ICD=488)!(ICD=449)!(ICD=538)

                       DO ADD

 +7                IF $LENGTH($PIECE(^ICD9(X,0),U))=4

                       Begin DoDot:2

 +8                        IF $EXTRACT(ICD,1,3)'?3N

                               QUIT 

 +9                        IF ($EXTRACT(ICD,4)?1".")&($EXTRACT(ICD,1)'=0)

                               DO ADD

                       End DoDot:2

               End DoDot:1

 +10       QUIT 

ADD       ;ADD ICD CODE TO FILE

 +1       ;S ICD2=$E(ICD,1,3),^ACHSICD9(X)=ICD_"^"_$$ICDDX^ICDCODE(ICD2),CT1=CT1+1 ;ACHS*3.1*23

 +2       ;ACHS*3.1*23

           SET ICD2=$EXTRACT(ICD,1,3)

           SET ^ACHSICD9(X)=ICD_"^"_$$ICDDX^ICDEX(ICD2)

           SET CT1=CT1+1

 +3        SET ^ACHSICD9("B",ICD2,X)=""

 +4        SET ^ACHSICD9(0)=CT1

 +5        WRITE "."

 +6       ;W !,CT1,". ",ICD_"^"_$$ICDDX^ICDCODE(ICD2)

 +7        QUIT 

DOCS      ;SET CHS RECORD in the temporary file WITH POSSIBLE ERRORS, START W/PAY DOCS FR 9-1-2010

 +1        WRITE !,"Setting the PO document global"

 +2        SET L=0

           FOR 

               SET L=$ORDER(^ACHSF("B",L))

               IF L'?1N.N

                   QUIT 

               Begin DoDot:1

 +3       ;I $P(^ACHSF(L,2),U,11)'="Y" W !,"Facility is not an FI site, routine will not be ran for ",$P(^DIC(4,DUZ(2),0),U) Q

 +4                SET ACHSPAY=3100900

                   SET CT=0

 +5                FOR 

                       SET ACHSPAY=$ORDER(^ACHSF(L,"TB",ACHSPAY))

                       IF ACHSPAY'?1N.N

                           QUIT 

                       FOR TYP="P","IP"

                           Begin DoDot:2

 +6                            SET L1=0

                               FOR 

                                   SET L1=$ORDER(^ACHSF(L,"TB",ACHSPAY,TYP,L1))

                                   IF L1'?1N.N

                                       QUIT 

                                   Begin DoDot:3

 +7                                    IF '$DATA(^ACHSF(L,"D",L1,9,0))

                                           QUIT 

 +8                                    IF $DATA(^ACHSICD(L,"D",L1,0))

                                           QUIT 

 +9                                    SET L2=0

                                       FOR 

                                           SET L2=$ORDER(^ACHSF(L,"D",L1,9,L2))

                                           IF L2'?1N.N

                                               QUIT 

                                           Begin DoDot:4

 +10                                           SET ICD2=$PIECE(^ACHSF(L,"D",L1,9,L2,0),U)

 +11                                           IF $DATA(^ACHSICD9("B",ICD2))