APCDEGP2.m

APCDEGP2 ; IHS/CMI/LAB - CONT. OF GROUP FORM DATA ENTRY ; 02 Mar 2010  9:13 AM

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

EDITCHKS ;EP;check and edit visit/pov info

 W !,"Checking Visit and POV data for this Patient...",!

 K AUPNTALK,APCDEFLG

VISIT ;

 S X=APCDDATE

 X $P(^DD(9000010,.01,0),U,5,99)

 I '$D(X) W !,APCDBEEP,APCDBEEP,?5,"A VISIT Cannot be Created for this Patient!",!?5,"You Must Correct any Problems and Re-Enter this VISIT through ENTER MODE!",! S APCDEFLG="" Q

CHKPOVS ;

 S APCDEGX=0 F  S APCDEGX=$O(^TMP("APCDEGP",$J,"POV",APCDEGX)) Q:APCDEGX=""  D CHKPOV1

 I $D(APCDEFLG) W !,APCDBEEP,APCDBEEP,?5,"One of the PURPOSE of VISITS is INVALID for this Patient!!",!?5,"You must Correct any Problems and Re-Enter this VISIT through ENTER MODE!" Q

 Q

CHKPOV1 ;

 K APCDTACC

 S (APCDEGY,Y)=$P($P(^TMP("APCDEGP",$J,"POV",APCDEGX,"APCDTPOV"),U),"`",2)

 D ^AUPNSICD

 I '$T S APCDEFLG="" Q

AGEEDIT ;

 Q:'$D(AUPNDAYS)

 ;Q:'$D(^ICD9(APCDEGY,9999999))

 ;I $P(^ICD9(APCDEGY,9999999),U)]"",($P(^ICD9(APCDEGY,9999999),U)>AUPNDAYS) D ACCEPT

 ;I $P(^ICD9(APCDEGY,9999999),U,2)]"",($P(^ICD9(APCDEGY,9999999),U,2)<AUPNDAYS) D ACCEPT

 S %=$$ICDDX^ICDEX(APCDEGY)

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

 I A]"",A>$$AGE^AUPNPAT(APCDPAT,$P(APCDDATE,".")) D ACCEPT

 I B]"",B<$$AGE^AUPNPAT(APCDPAT,$P(APCDDATE,".")) D ACCEPT

 Q

ACCEPT ;

 W !!,$C(7),$C(7),"WARNING:  The Patient's age is outside the IHS edit age range",!,"for this ICD Code:  ",@APCDRVON,$P($$ICDDX^ICDEX(APCDEGY),U,2),@APCDRVOF,!

 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:  ",$P(^ICD9(APCDEGY,9999999),U),?35,"ICD Edit Upper Age:  ",$P(^ICD9(APCDEGY,9999999),U,2)

 W "Patient's DOB:  ",$G(APCDRDOB),?35,"Patient's Age in Days:  ",AUPNDAYS,!

 S %=$$ICDDX^ICDEX(APCDEGY)

 S (A,B)=""  ;CSV

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

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

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

 W "ICD Edit Lower Age:  ",A,?35,"ICD Edit Upper Age:  ",B

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

 S APCDTACC=""

 Q

APCDEGP2  ; IHS/CMI/LAB - CONT. OF GROUP FORM DATA ENTRY ; 02 Mar 2010  9:13 AM

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

EDITCHKS  ;EP;check and edit visit/pov info

 +1        WRITE !,"Checking Visit and POV data for this Patient...",!

 +2        KILL AUPNTALK,APCDEFLG

VISIT     ;

 +1        SET X=APCDDATE

 +2        XECUTE $PIECE(^DD(9000010,.01,0),U,5,99)

 +3        IF '$DATA(X)

               WRITE !,APCDBEEP,APCDBEEP,?5,"A VISIT Cannot be Created for this Patient!",!?5,"You Must Correct any Problems and Re-Enter this VISIT through ENTER MODE!",!

               SET APCDEFLG=""

               QUIT 

CHKPOVS   ;

 +1        SET APCDEGX=0

           FOR 

               SET APCDEGX=$ORDER(^TMP("APCDEGP",$JOB,"POV",APCDEGX))

               IF APCDEGX=""

                   QUIT 

               DO CHKPOV1

 +2        IF $DATA(APCDEFLG)

               WRITE !,APCDBEEP,APCDBEEP,?5,"One of the PURPOSE of VISITS is INVALID for this Patient!!",!?5,"You must Correct any Problems and Re-Enter this VISIT through ENTER MODE!"

               QUIT 

 +3        QUIT 

CHKPOV1   ;

 +1        KILL APCDTACC

 +2        SET (APCDEGY,Y)=$PIECE($PIECE(^TMP("APCDEGP",$JOB,"POV",APCDEGX,"APCDTPOV"),U),"`",2)

 +3        DO ^AUPNSICD

 +4        IF '$TEST

               SET APCDEFLG=""

               QUIT 

AGEEDIT   ;

 +1        IF '$DATA(AUPNDAYS)

               QUIT 

 +2       ;Q:'$D(^ICD9(APCDEGY,9999999))

 +3       ;I $P(^ICD9(APCDEGY,9999999),U)]"",($P(^ICD9(APCDEGY,9999999),U)>AUPNDAYS) D ACCEPT

 +4       ;I $P(^ICD9(APCDEGY,9999999),U,2)]"",($P(^ICD9(APCDEGY,9999999),U,2)<AUPNDAYS) D ACCEPT

 +5        SET %=$$ICDDX^ICDEX(APCDEGY)

 +6       ;CSV

           SET (A,B)=""

 +7       ;CSV

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

               Begin DoDot:1

 +8       ;CSV

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

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

               End DoDot:1

               IF 1

 +9       IF '$TEST

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

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

 +10       IF A]""

               IF A>$$AGE^AUPNPAT(APCDPAT,$PIECE(APCDDATE,"."))

                   DO ACCEPT

 +11       IF B]""

               IF B<$$AGE^AUPNPAT(APCDPAT,$PIECE(APCDDATE,"."))

                   DO ACCEPT

 +12       QUIT 

ACCEPT    ;

 +1        WRITE !!,$CHAR(7),$CHAR(7),"WARNING:  The Patient's age is outside the IHS edit age range",!,"for this ICD Code:  ",@APCDRVON,$PIECE($$ICDDX^ICDEX(APCDEGY),U,2),@APCDRVOF,!

 +2        IF $DATA(AUPNDOB)

               SET Y=AUPNDOB

               DO DD^%DT

               SET APCDRDOB=Y

 +3       ;W "Patient's DOB:  ",$G(APCDRDOB),?35,"Patient's Age in Days:  ",AUPNDAYS,!,"ICD Edit Lower Age:  ",$P(^ICD9(APCDEGY,9999999),U),?35,"ICD Edit Upper Age:  ",$P(^ICD9(APCDEGY,9999999),U,2)

 +4        WRITE "Patient's DOB:  ",$GET(APCDRDOB),?35,"Patient's Age in Days:  ",AUPNDAYS,!

 +5        SET %=$$ICDDX^ICDEX(APCDEGY)

 +6       ;CSV

           SET (A,B)=""

 +7       ;CSV

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

               Begin DoDot:1

 +8       ;CSV

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

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

               End DoDot:1

               IF 1

 +9       IF '$TEST

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

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

 +10       WRITE "ICD Edit Lower Age:  ",A,?35,"ICD Edit Upper Age:  ",B

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

           SET %=2

           DO YN^DICN

           IF %'=1

               SET Y=-1

               SET APCDEFLG=""

               QUIT 

 +12       SET APCDTACC=""

 +13       QUIT