- 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
