APCDR12.m

APCDR12 ; IHS/CMI/LAB - V SKIN TEST REVIEW ;

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

SKINTST ; Skin Test-CP 49-50

 S APCDSK=$P(^AUPNVSK(APCDEDFN,0),U) I APCDSK="" S APCDE="E010" D ERR G XIT

 I '$D(^AUTTSK(APCDSK,0)) S APCDE="E010" D ERR G XIT

 I $D(^AUTTSK(APCDSK,0)) S APCDSK=$P(^(0),U,2)

 I APCDSK="" S APCDE="E010" D ERR G XIT

 ;

XIT ;

 K APCDSK,APCDE

 Q

ERR ;

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

 D ERR^APCDRV

 Q

APCDR12   ; IHS/CMI/LAB - V SKIN TEST REVIEW ;

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

SKINTST   ; Skin Test-CP 49-50

 +1        SET APCDSK=$PIECE(^AUPNVSK(APCDEDFN,0),U)

           IF APCDSK=""

               SET APCDE="E010"

               DO ERR

               GOTO XIT

 +2        IF '$DATA(^AUTTSK(APCDSK,0))

               SET APCDE="E010"

               DO ERR

               GOTO XIT

 +3        IF $DATA(^AUTTSK(APCDSK,0))

               SET APCDSK=$PIECE(^(0),U,2)

 +4        IF APCDSK=""

               SET APCDE="E010"

               DO ERR

               GOTO XIT

 +5       ;

XIT       ;

 +1        KILL APCDSK,APCDE

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.12

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT