APCDR11.m

APCDR11 ; IHS/CMI/LAB - V IMMUNIZATION REVIEW ;

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

IMMUN ; Immunzation code.-CP 49-50.

 S APCDIMM=$P(^AUPNVIMM(APCDEDFN,0),U) I APCDIMM="" S APCDE="E009" D ERR G XIT

 I '$D(^AUTTIMM(APCDIMM,0)) S APCDE="E009" D ERR G XIT

 I $P(^AUTTIMM(APCDIMM,0),U,3)="" S APCDE="E009" D ERR G XIT

 ;

XIT ; Clean up and exit

 K APCDE,APCDIMM

 Q

ERR ;

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

 D ERR^APCDRV

 Q

APCDR11   ; IHS/CMI/LAB - V IMMUNIZATION REVIEW ;

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

IMMUN     ; Immunzation code.-CP 49-50.

 +1        SET APCDIMM=$PIECE(^AUPNVIMM(APCDEDFN,0),U)

           IF APCDIMM=""

               SET APCDE="E009"

               DO ERR

               GOTO XIT

 +2        IF '$DATA(^AUTTIMM(APCDIMM,0))

               SET APCDE="E009"

               DO ERR

               GOTO XIT

 +3        IF $PIECE(^AUTTIMM(APCDIMM,0),U,3)=""

               SET APCDE="E009"

               DO ERR

               GOTO XIT

 +4       ;

XIT       ; Clean up and exit

 +1        KILL APCDE,APCDIMM

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.11

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT