APCDPPOV.m

APCDPPOV ; IHS/CMI/LAB - post selection on V POV ;  

 ;;2.0;IHS PCC SUITE;**2,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 %=$$ICDDX^ICDEX(APCDY,$S($G(APCDVSIT):$$VD^APCLV(APCDVSIT),1:DT))

 Q:'$G(APCDVSIT)

 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(APCDY,9999999)),U),B=$P($G(^ICD9(APCDY,9999999)),U,2)

 I A]"",A>$$AGE^AUPNPAT($P($G(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT)) D ACCEPT

 I B]"",B<$$AGE^AUPNPAT($P($G(^AUPNVSIT(APCDVSIT,0)),U,5),$$VD^APCLV(APCDVSIT)) 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 Edit Lower Age:  ",A,?35,"ICD Edit Upper Age:  ",B

 I APCDCAT="H",'$D(^APCDINPT(9,11,"AC",$P(^ICD9(APCDY,0),U))) W !!,"An ACCEPT command is not allowed for this code.  Refer to IHS Direct",!,"Inpatient Edit Documentation for further explanation.  You cannot use this code.",! S Y=-1 Q

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

 S APCDTACC=""

 Q

XIT ;

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

 K APCDY,APCDRDOB,APCDSY

 Q

APCDPPOV  ; IHS/CMI/LAB - post selection on V POV ;  

 +1       ;;2.0;IHS PCC SUITE;**2,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 %=$$ICDDX^ICDEX(APCDY,$SELECT($GET(APCDVSIT):$$VD^APCLV(APCDVSIT),1:DT))

 +7        IF '$GET(APCDVSIT)

               QUIT 

 +8       ;CSV

           SET (A,B)=""

 +9       ;CSV

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

               Begin DoDot:1

 +10      ;CSV

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

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

               End DoDot:1

               IF 1

 +11      IF '$TEST

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

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

 +12       IF A]""

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

                   DO ACCEPT

 +13       IF B]""

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

                   DO ACCEPT

 +14       DO XIT

 +15       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 Edit Lower Age:  ",A,?35,"ICD Edit Upper Age:  ",B

 +6        IF APCDCAT="H"

               IF '$DATA(^APCDINPT(9,11,"AC",$PIECE(^ICD9(APCDY,0),U)))

                   WRITE !!,"An ACCEPT command is not allowed for this code.  Refer to IHS Direct",!,"Inpatient Edit Documentation for further explanation.  You cannot use this code.",!

                   SET Y=-1

                   QUIT 

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

           SET %=2

           DO YN^DICN

           IF %'=1

               SET Y=-1

               QUIT 

 +8        SET APCDTACC=""

 +9        QUIT 

XIT       ;

 +1        IF Y'=-1

               IF $DATA(APCDSY)

                   SET Y=APCDSY

 +2        KILL APCDY,APCDRDOB,APCDSY

 +3        QUIT