APCDRICD.m

APCDRICD ; IHS/CMI/LAB - RECODE ICD TO APC ; 25 Feb 2010  11:46 AM

 ;;2.0;IHS PCC SUITE;**1,11**;MAY 14, 2009;Build 58

 K APCDAGEE

EIN ; SCREEN OUT E CODES AND INACTIVE CODES

 NEW %

 I $G(APCDICDP) S %=APCDICDP G EIN1

 S %=$$CODEABA^ICDEX(APCDICD,80)

EIN1 ;

 I $$CHKE1^AUPNSICD(+%) S APCDE="E047" Q

 I APCDICD=.9999!(APCDICD="ZZZ.999") S APCDE="E026" Q

 ;G:$E(APCDICD)="." SEX I $L($P(APCDICD,".",2))>2 S APCDE="E003" Q

SEX ;

 NEW S,%

 S %=$$ICDDX^ICDEX(APCDICDP,$$VD^APCLV(APCDVSIT)) S S=$P(%,U,11)

 I S]"",AUPNSEX'=S S APCDE="E042" Q

AGE ; IF THERE IS AGE CRITERIA DATA AVAILABLE CHECK TO SEE THAT IT FITS THE CRITERIA

 S (A,B)=""  ;CSV

 I $$VERSION^XPDUTL("BCSV")]"" D  I 1  ;CSV

 .S A=$P(%,U,15),B=$P(%,U,16)  ;CSV

 E   S A=$P($G(^ICD9(APCDICDP,9999999)),U),B=$P($G(^ICD9(APCDICDP,9999999)),U,2)

 I A]"",A>$$AGE^AUPNPAT($P($G(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT)) S APCDAGEE="" Q

 I B]"",B<$$AGE^AUPNPAT($P($G(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT)) S APCDAGEE="" Q

 Q

 ;

APCDRICD  ; IHS/CMI/LAB - RECODE ICD TO APC ; 25 Feb 2010  11:46 AM

 +1       ;;2.0;IHS PCC SUITE;**1,11**;MAY 14, 2009;Build 58

 +2        KILL APCDAGEE

EIN       ; SCREEN OUT E CODES AND INACTIVE CODES

 +1        NEW %

 +2        IF $GET(APCDICDP)

               SET %=APCDICDP

               GOTO EIN1

 +3        SET %=$$CODEABA^ICDEX(APCDICD,80)

EIN1      ;

 +1        IF $$CHKE1^AUPNSICD(+%)

               SET APCDE="E047"

               QUIT 

 +2        IF APCDICD=.9999!(APCDICD="ZZZ.999")

               SET APCDE="E026"

               QUIT 

 +3       ;G:$E(APCDICD)="." SEX I $L($P(APCDICD,".",2))>2 S APCDE="E003" Q

SEX       ;

 +1        NEW S,%

 +2        SET %=$$ICDDX^ICDEX(APCDICDP,$$VD^APCLV(APCDVSIT))

           SET S=$PIECE(%,U,11)

 +3        IF S]""

               IF AUPNSEX'=S

                   SET APCDE="E042"

                   QUIT 

AGE       ; IF THERE IS AGE CRITERIA DATA AVAILABLE CHECK TO SEE THAT IT FITS THE CRITERIA

 +1       ;CSV

           SET (A,B)=""

 +2       ;CSV

           IF $$VERSION^XPDUTL("BCSV")]""

               Begin DoDot:1

 +3       ;CSV

                   SET A=$PIECE(%,U,15)

                   SET B=$PIECE(%,U,16)

               End DoDot:1

               IF 1

 +4       IF '$TEST

               SET A=$PIECE($GET(^ICD9(APCDICDP,9999999)),U)

               SET B=$PIECE($GET(^ICD9(APCDICDP,9999999)),U,2)

 +5        IF A]""

               IF A>$$AGE^AUPNPAT($PIECE($GET(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT))

                   SET APCDAGEE=""

                   QUIT 

 +6        IF B]""

               IF B<$$AGE^AUPNPAT($PIECE($GET(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT))

                   SET APCDAGEE=""

                   QUIT 

 +7        QUIT 

 +8       ;