APCDR19.m

APCDR19 ; IHS/CMI/LAB - CHECK V ACTIVITY TIME ;

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

 ;

ACT ;

 S APCDACT=$P(^AUPNVTM(APCDEDFN,0),U) I APCDACT=""!(+APCDACT'=APCDACT) S APCDE="E052" D ERR G XIT

 S APCDACT=$P(^AUPNVTM(APCDEDFN,0),U,4) G:APCDACT="" XIT

 I APCDACT'=+APCDACT S APCDE="E053" D ERR G XIT

XIT ;

 K APCDE,APCDACT

 Q

ERR ;

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

 D ERR^APCDRV

 Q

APCDR19   ; IHS/CMI/LAB - CHECK V ACTIVITY TIME ;

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

 +2       ;

ACT       ;

 +1        SET APCDACT=$PIECE(^AUPNVTM(APCDEDFN,0),U)

           IF APCDACT=""!(+APCDACT'=APCDACT)

               SET APCDE="E052"

               DO ERR

               GOTO XIT

 +2        SET APCDACT=$PIECE(^AUPNVTM(APCDEDFN,0),U,4)

           IF APCDACT=""

               GOTO XIT

 +3        IF APCDACT'=+APCDACT

               SET APCDE="E053"

               DO ERR

               GOTO XIT

XIT       ;

 +1        KILL APCDE,APCDACT

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.19

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT