APCDVCH2.m

APCDVCH2 ; IHS/CMI/LAB - CONT. HOSP REVIEW ;

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

START ;

 D CHKADM

 D CHKTS

 ;D CHKAGE

 ;D DATES

 ;

XIT ;

 Q

 ;

 ;

ERR ;

 D ERR^APCDRV

 Q

CHKTS ;

 I $P(APCDVINR,U,12)="" W !,$C(7),"WARNING:  Admitting Diagnosis is Missing!",!

 I APCDTS="07",AUPNDAYS]"",AUPNDAYS>1 W !!,"WARNING: Admitting or Discharge Service cannot be NEWBORN if Patient is over 1 day old.",!

 I APCDTS="11",AUPNDAYS]"",AUPNDAYS>5479 W !!,"WARNING: Admitting Service is PEDIATRICS (11) and the patient is over 15 years old.",!,"Please Review.",!

 I APCDTS="05"!(APCDTS="08"),AUPNSEX'="F" W !!,$C(7),$C(7),"Patient Must be FEMALE if Admitting Service is OBSTETRICS (08) or ",!,"GYNEGOLOGY (05)!",!

 ;I APCDDS="08",AUPNDAYS]"",(AUPNDAYS<3652!(AUPNDAYS>20088)) W !!,$C(7),$C(7),"This Patient's age is outside the IHS edit range for Admitting/Discharge",!,"Service 08!  Please Review!",!

 I APCDDS="11",AUPNDAYS]"",AUPNDAYS>5479 W !!,"WARNING: Discharge Service PEDIATRICS (11) and the patient is over",!,"15 years old!  Please review.",!

 I APCDDS="05"!(APCDDS="08"),AUPNSEX'="F" W !!,$C(7),$C(7),"Patient Must be FEMALE if Discharge Service is OBSTETRICS (08) or ",!,"GYNEGOLOGY (05)!",!

 ;I APCDDS="08",AUPNDAYS]"",(AUPNDAYS<3652!(AUPNDAYS>20088)) W !!,$C(7),$C(7),"This Patient's age is outside the IHS edit range for Admitting/Discharge",!,"Service 08!  Please Review!",!

 Q

 ;

CHKAGE ;

 ;Q:$D(APCDACC)

 Q:AUPNDAYS>5

 ;LORI NEED CODES BELOW ICD10**

 I $$IMP^AUPNSICD($$VD^APCLV(APCDVSIT))=1,$E($P(APCDVCPV("P"),U),1,2)'="V3" W !,$C(7),$C(7),"WARNING:  The Admission Date is within 5 days of the DOB, Please Review.",!

 Q

CHKADM ;check admission date

 S APCDDIS=$P($P(APCDVINR,U),"."),APCDADM=$P($P(APCDVREC,U),".")

 I APCDDIS<APCDADM W !!,"Admission Date is less than Discharge Date!!",! Q

 ;Q:APCDADM'=AUPNDOB

 ;Q:$D(APCDACC)

 ;LORI - NEED CODES BELOW ICD10**

 ;I $$IMP^AUPNSICD($$VD^APCLV(APCDVSIT))=1,$E($P(APCDVCPV("P"),U),1,2)'="V3" W !,$C(7),$C(7),"WARNING:  DOB is equal to Admission Date and 1st DX is NOT V30-V39.  PLEASE REVIEW.",!

 Q

 ;

DATES ;

 S X1=$P(APCDVINR,U),X2=$P(APCDVREC,U) D ^%DTC I X<0 W !,$C(7),"WARNING: Discharge Date MUST be greater than or equal to Admission Date!",!,"PLEASE CORRECT!",!

 I X>99 W !,$C(7),"WARNING: Length of Stay is > 99 days!.",!,"Notify your Supervisor!",!

 Q

APCDVCH2  ; IHS/CMI/LAB - CONT. HOSP REVIEW ;

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

START     ;

 +1        DO CHKADM

 +2        DO CHKTS

 +3       ;D CHKAGE

 +4       ;D DATES

 +5       ;

XIT       ;

 +1        QUIT 

 +2       ;

 +3       ;

ERR       ;

 +1        DO ERR^APCDRV

 +2        QUIT 

CHKTS     ;

 +1        IF $PIECE(APCDVINR,U,12)=""

               WRITE !,$CHAR(7),"WARNING:  Admitting Diagnosis is Missing!",!

 +2        IF APCDTS="07"

               IF AUPNDAYS]""

                   IF AUPNDAYS>1

                       WRITE !!,"WARNING: Admitting or Discharge Service cannot be NEWBORN if Patient is over 1 day old.",!

 +3        IF APCDTS="11"

               IF AUPNDAYS]""

                   IF AUPNDAYS>5479

                       WRITE !!,"WARNING: Admitting Service is PEDIATRICS (11) and the patient is over 15 years old.",!,"Please Review.",!

 +4        IF APCDTS="05"!(APCDTS="08")

               IF AUPNSEX'="F"

                   WRITE !!,$CHAR(7),$CHAR(7),"Patient Must be FEMALE if Admitting Service is OBSTETRICS (08) or ",!,"GYNEGOLOGY (05)!",!

 +5       ;I APCDDS="08",AUPNDAYS]"",(AUPNDAYS<3652!(AUPNDAYS>20088)) W !!,$C(7),$C(7),"This Patient's age is outside the IHS edit range for Admitting/Discharge",!,"Service 08!  Please Review!",!

 +6        IF APCDDS="11"

               IF AUPNDAYS]""

                   IF AUPNDAYS>5479

                       WRITE !!,"WARNING: Discharge Service PEDIATRICS (11) and the patient is over",!,"15 years old!  Please review.",!

 +7        IF APCDDS="05"!(APCDDS="08")

               IF AUPNSEX'="F"

                   WRITE !!,$CHAR(7),$CHAR(7),"Patient Must be FEMALE if Discharge Service is OBSTETRICS (08) or ",!,"GYNEGOLOGY (05)!",!

 +8       ;I APCDDS="08",AUPNDAYS]"",(AUPNDAYS<3652!(AUPNDAYS>20088)) W !!,$C(7),$C(7),"This Patient's age is outside the IHS edit range for Admitting/Discharge",!,"Service 08!  Please Review!",!

 +9        QUIT 

 +10      ;

CHKAGE    ;

 +1       ;Q:$D(APCDACC)

 +2        IF AUPNDAYS>5

               QUIT 

 +3       ;LORI NEED CODES BELOW ICD10**

 +4        IF $$IMP^AUPNSICD($$VD^APCLV(APCDVSIT))=1

               IF $EXTRACT($PIECE(APCDVCPV("P"),U),1,2)'="V3"

                   WRITE !,$CHAR(7),$CHAR(7),"WARNING:  The Admission Date is within 5 days of the DOB, Please Review.",!

 +5        QUIT 

CHKADM    ;check admission date

 +1        SET APCDDIS=$PIECE($PIECE(APCDVINR,U),".")

           SET APCDADM=$PIECE($PIECE(APCDVREC,U),".")

 +2        IF APCDDIS<APCDADM

               WRITE !!,"Admission Date is less than Discharge Date!!",!

               QUIT 

 +3       ;Q:APCDADM'=AUPNDOB

 +4       ;Q:$D(APCDACC)

 +5       ;LORI - NEED CODES BELOW ICD10**

 +6       ;I $$IMP^AUPNSICD($$VD^APCLV(APCDVSIT))=1,$E($P(APCDVCPV("P"),U),1,2)'="V3" W !,$C(7),$C(7),"WARNING:  DOB is equal to Admission Date and 1st DX is NOT V30-V39.  PLEASE REVIEW.",!

 +7        QUIT 

 +8       ;

DATES     ;

 +1        SET X1=$PIECE(APCDVINR,U)

           SET X2=$PIECE(APCDVREC,U)

           DO ^%DTC

           IF X<0

               WRITE !,$CHAR(7),"WARNING: Discharge Date MUST be greater than or equal to Admission Date!",!,"PLEASE CORRECT!",!

 +2        IF X>99

               WRITE !,$CHAR(7),"WARNING: Length of Stay is > 99 days!.",!,"Notify your Supervisor!",!

 +3        QUIT