- 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
