APCDPOP.m

APCDPOP ; IHS/CMI/LAB - post selection on V PROCEDURE ;

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

 ;

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

 Q:$D(APCDTACC)

 Q:'$D(APCDTPCC)

 G:'$D(AUPNDAYS) XIT

 S APCDSY=Y,APCDY=+Y

 NEW %,A,B

 S %=$$ICDOP^ICDEX(APCDY,$S($G(APCDVSIT):$$VD^APCLV(APCDVSIT),1:DT),,"I")

 S (A,B)=""  ;CSV

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

 .S A="",B=""  ;CSV

 E  S A=$P($G(^ICD0(APCDY,9999999)),U),B=$P($G(^ICD0(APCDY,9999999)),U,2)

 I A]"",A>AUPNDAYS D ACCEPT

 I B]"",B<AUPNDAYS D ACCEPT

 D XIT

 Q

ACCEPT ;

 I $D(AUPNTALK) S APCDTACC="" Q

 I $D(ZTQUEUED) S APCDTACC="" Q

 W !!,$C(7),$C(7),"WARNING:  The Patient's age is outside the IHS edit age range for this ICD Code!",!

 I $D(AUPNDOB) S Y=AUPNDOB D DD^%DT S APCDRDOB=Y

 W "Patient's DOB:  ",$G(APCDRDOB),?35,"Patient's Age in Days:  ",AUPNDAYS,!,"ICD Proc Edit Lower Age:  ",$P(^ICD0(APCDY,9999999),U),?35,"ICD Proc Edit Upper Age:  ",$P(^ICD0(APCDY,9999999),U,2)

 W !!,"Do you still want to use this code" S %=2 D YN^DICN I %'=1 S Y=-1 Q

 S APCDTACC=1

 Q

XIT ;

 I Y'=-1,$D(APCDSY) S Y=APCDSY

 K APCDY,APCDRDOB,APCDSY

 Q

APCDPOP   ; IHS/CMI/LAB - post selection on V PROCEDURE ;

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

 +2       ;

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

 +1        IF $DATA(APCDTACC)

               QUIT 

 +2        IF '$DATA(APCDTPCC)

               QUIT 

 +3        IF '$DATA(AUPNDAYS)

               GOTO XIT

 +4        SET APCDSY=Y

           SET APCDY=+Y

 +5        NEW %,A,B

 +6        SET %=$$ICDOP^ICDEX(APCDY,$SELECT($GET(APCDVSIT):$$VD^APCLV(APCDVSIT),1:DT),,"I")

 +7       ;CSV

           SET (A,B)=""

 +8       ;CSV

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

               Begin DoDot:1

 +9       ;CSV

                   SET A=""

                   SET B=""

               End DoDot:1

               IF 1

 +10      IF '$TEST

               SET A=$PIECE($GET(^ICD0(APCDY,9999999)),U)

               SET B=$PIECE($GET(^ICD0(APCDY,9999999)),U,2)

 +11       IF A]""

               IF A>AUPNDAYS

                   DO ACCEPT

 +12       IF B]""

               IF B<AUPNDAYS

                   DO ACCEPT

 +13       DO XIT

 +14       QUIT 

ACCEPT    ;

 +1        IF $DATA(AUPNTALK)

               SET APCDTACC=""

               QUIT 

 +2        IF $DATA(ZTQUEUED)

               SET APCDTACC=""

               QUIT 

 +3        WRITE !!,$CHAR(7),$CHAR(7),"WARNING:  The Patient's age is outside the IHS edit age range for this ICD Code!",!

 +4        IF $DATA(AUPNDOB)

               SET Y=AUPNDOB

               DO DD^%DT

               SET APCDRDOB=Y

 +5        WRITE "Patient's DOB:  ",$GET(APCDRDOB),?35,"Patient's Age in Days:  ",AUPNDAYS,!,"ICD Proc Edit Lower Age:  ",$PIECE(^ICD0(APCDY,9999999),U),?35,"ICD Proc Edit Upper Age:  ",$PIECE(^ICD0(APCDY,9999999),U,2)

 +6        WRITE !!,"Do you still want to use this code"

           SET %=2

           DO YN^DICN

           IF %'=1

               SET Y=-1

               QUIT 

 +7        SET APCDTACC=1

 +8        QUIT 

XIT       ;

 +1        IF Y'=-1

               IF $DATA(APCDSY)

                   SET Y=APCDSY

 +2        KILL APCDY,APCDRDOB,APCDSY

 +3        QUIT