APCDR13.m

APCDR13 ; IHS/CMI/LAB - V EXAM REVIEW ;

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

EXAM ; Exam Code -- Char Pos 49-50

 S APCDXAM=$P(^AUPNVXAM(APCDEDFN,0),U) I APCDXAM="" S APCDE="E012" D ERR G XIT

 I '$D(^AUTTEXAM(APCDXAM,0)) S APCDE="E012" D ERR G XIT

 I $P(^AUTTEXAM(APCDXAM,0),U,2)="" S APCDE="E012" D ERR G XIT

 I $P(^AUTTEXAM(APCDXAM,0),U,2)=15,AUPNSEX="M" S APCDE="E049" D ERR G XIT

 ;

XIT ;

 K APCDXAM,APCDE

 Q

ERR ;

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

 D ERR^APCDRV

 Q

APCDR13   ; IHS/CMI/LAB - V EXAM REVIEW ;

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

EXAM      ; Exam Code -- Char Pos 49-50

 +1        SET APCDXAM=$PIECE(^AUPNVXAM(APCDEDFN,0),U)

           IF APCDXAM=""

               SET APCDE="E012"

               DO ERR

               GOTO XIT

 +2        IF '$DATA(^AUTTEXAM(APCDXAM,0))

               SET APCDE="E012"

               DO ERR

               GOTO XIT

 +3        IF $PIECE(^AUTTEXAM(APCDXAM,0),U,2)=""

               SET APCDE="E012"

               DO ERR

               GOTO XIT

 +4        IF $PIECE(^AUTTEXAM(APCDXAM,0),U,2)=15

               IF AUPNSEX="M"

                   SET APCDE="E049"

                   DO ERR

                   GOTO XIT

 +5       ;

XIT       ;

 +1        KILL APCDXAM,APCDE

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.13

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT