- 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
