APCDR05.m

APCDR05 ; IHS/CMI/LAB - V DENTAL REVIEW ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

RESULT ;

 S APCDEREC=^AUPNVDEN(APCDEDFN,0)

 S APCDADA=$P(APCDEREC,U) I APCDADA="" S APCDE="E050" D ERR G XIT

 I '$D(^AUTTADA(APCDADA,0)) S APCDE="E050" D ERR G XIT

 S APCDADA=$P(^AUTTADA(APCDADA,0),U)

 I $L(APCDADA)'=4 S APCDE="E057" D ERR G XIT

 ; pedtp6

XIT ; Clean up and exit

 K APCDEREC,APCDADA,APCDE

 Q

ERR ;

 S APCDE("FILE")=9000010.05,APCDE("ENTRY")=APCDEDFN

 D ERR^APCDRV

 Q

APCDR05   ; IHS/CMI/LAB - V DENTAL REVIEW ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

RESULT    ;

 +1        SET APCDEREC=^AUPNVDEN(APCDEDFN,0)

 +2        SET APCDADA=$PIECE(APCDEREC,U)

           IF APCDADA=""

               SET APCDE="E050"

               DO ERR

               GOTO XIT

 +3        IF '$DATA(^AUTTADA(APCDADA,0))

               SET APCDE="E050"

               DO ERR

               GOTO XIT

 +4        SET APCDADA=$PIECE(^AUTTADA(APCDADA,0),U)

 +5        IF $LENGTH(APCDADA)'=4

               SET APCDE="E057"

               DO ERR

               GOTO XIT

 +6       ; pedtp6

XIT       ; Clean up and exit

 +1        KILL APCDEREC,APCDADA,APCDE

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.05

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT