APCLRCHA.m

APCLRCHA ; IHS/CMI/LAB - RECODE ICD 9 DIAGNOSIS CODE TO CHA RECODE ;

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

 ;input variable - APCLIPTR contains the ICD 9 DX pointer value

 ;output variable - APCLCODE contains the CHA recode pointer value

 ;

 ;cmi/anch/maw 9/10/2007 code set versioning

 ;

 Q:'$G(APCLIPTR)

 ;S (APCLX,APCLICD)=$P(^ICD9(APCLIPTR,0),U),APCLCODE=""  ;cmi/anch/maw 9/10/2007 orig line

 S (APCLX,APCLICD)=$P($$ICDDX^ICDEX(APCLIPTR),U,2),APCLCODE=""  ;cmi/anch/maw 9/10/2007 csv

 S APCLCODE=$P($$ICDDX^ICDEX(APCLIPTR),U,6)

 Q

 S APCLICD=$P(APCLICD,".")_$P(APCLICD,".",2)_" "

 I $E(APCLX)="V" S APCLX=(9_$E(APCLX,2,9999)-.000001),APCLX="V"_$E(APCLX,2,9999),APCLX=$P(APCLX,".")_$P(APCLX,".",2)_" " G HIGH

 I $E(APCLX)="0" S APCLX=(9_$E(APCLX,2,9999)-.000001),APCLX="0"_$E(APCLX,2,9999),APCLX=$P(APCLX,".")_$P(APCLX,".",2)_" " G HIGH

 I $E(APCLX)="." S APCLX=(9_$E(APCLX,2,9999)-.000001),APCLX="."_$E(APCLX,2,9999),APCLX=$P(APCLX,".")_$P(APCLX,".",2)_" " G HIGH

 S APCLX=APCLX-.000001

 S APCLX=($P(APCLX,".")_$P(APCLX,".",2))_" "

HIGH S APCLHIGH=$O(^AUTTCHA("AH",APCLX)) I APCLHIGH="" Q

 S APCLDA1=$O(^AUTTCHA("AH",APCLHIGH,""))

 S APCLDA2=$O(^AUTTCHA("AH",APCLHIGH,APCLDA1,""))

 S APCLLOW=$P(^AUTTCHA(APCLDA1,11,APCLDA2,0),U)_" "

 I APCLLOW]APCLICD Q

 S APCLCODE=APCLDA1

 Q

APCLRCHA  ; IHS/CMI/LAB - RECODE ICD 9 DIAGNOSIS CODE TO CHA RECODE ;

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

 +2       ;input variable - APCLIPTR contains the ICD 9 DX pointer value

 +3       ;output variable - APCLCODE contains the CHA recode pointer value

 +4       ;

 +5       ;cmi/anch/maw 9/10/2007 code set versioning

 +6       ;

 +7        IF '$GET(APCLIPTR)

               QUIT 

 +8       ;S (APCLX,APCLICD)=$P(^ICD9(APCLIPTR,0),U),APCLCODE=""  ;cmi/anch/maw 9/10/2007 orig line

 +9       ;cmi/anch/maw 9/10/2007 csv

           SET (APCLX,APCLICD)=$PIECE($$ICDDX^ICDEX(APCLIPTR),U,2)

           SET APCLCODE=""

 +10       SET APCLCODE=$PIECE($$ICDDX^ICDEX(APCLIPTR),U,6)

 +11       QUIT 

 +12       SET APCLICD=$PIECE(APCLICD,".")_$PIECE(APCLICD,".",2)_" "

 +13       IF $EXTRACT(APCLX)="V"

               SET APCLX=(9_$EXTRACT(APCLX,2,9999)-.000001)

               SET APCLX="V"_$EXTRACT(APCLX,2,9999)

               SET APCLX=$PIECE(APCLX,".")_$PIECE(APCLX,".",2)_" "

               GOTO HIGH

 +14       IF $EXTRACT(APCLX)="0"

               SET APCLX=(9_$EXTRACT(APCLX,2,9999)-.000001)

               SET APCLX="0"_$EXTRACT(APCLX,2,9999)

               SET APCLX=$PIECE(APCLX,".")_$PIECE(APCLX,".",2)_" "

               GOTO HIGH

 +15       IF $EXTRACT(APCLX)="."

               SET APCLX=(9_$EXTRACT(APCLX,2,9999)-.000001)

               SET APCLX="."_$EXTRACT(APCLX,2,9999)

               SET APCLX=$PIECE(APCLX,".")_$PIECE(APCLX,".",2)_" "

               GOTO HIGH

 +16       SET APCLX=APCLX-.000001

 +17       SET APCLX=($PIECE(APCLX,".")_$PIECE(APCLX,".",2))_" "

HIGH       SET APCLHIGH=$ORDER(^AUTTCHA("AH",APCLX))

           IF APCLHIGH=""

               QUIT 

 +1        SET APCLDA1=$ORDER(^AUTTCHA("AH",APCLHIGH,""))

 +2        SET APCLDA2=$ORDER(^AUTTCHA("AH",APCLHIGH,APCLDA1,""))

 +3        SET APCLLOW=$PIECE(^AUTTCHA(APCLDA1,11,APCLDA2,0),U)_" "

 +4        IF APCLLOW]APCLICD

               QUIT 

 +5        SET APCLCODE=APCLDA1

 +6        QUIT