APCDR06.m

APCDR06 ; IHS/CMI/LAB - V PROVIDER REVIEW ;

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

 ;

 ;IHS/CMI/LAB patch 1 for file 200 converted sites

PRIPRV ; 

 I $P(^DD(9000010.06,.01,0),U,2)[200 D PRI200 G XIT

 S APCDEREC=^AUPNVPRV(APCDEDFN,0),APCDPRV=$P(APCDEREC,U),APCDY=""

 I '$D(^DIC(6,APCDPRV)) S APCDE="E002" D ERR G XIT

 I '$D(^DIC(6,APCDPRV,9999999)) S APCDE="E002" D ERR G XIT

 I $P(^DIC(6,APCDPRV,9999999),U)="" S APCDE="E028" D ERR G XIT

 S APCDY=$P(^DIC(6,APCDPRV,0),U,4)

 I APCDY="" S APCDE="E027" D ERR G XIT

 I '$D(^DIC(7,APCDY,9999999)) S APCDE="E027" D ERR G XIT

 I $P(^DIC(7,APCDY,9999999),U)="" S APCDE="E027" D ERR G XIT

 I $P(^DIC(6,APCDPRV,9999999),U,2)="" S APCDE="E002" D ERR G XIT

 ;

XIT ; Clean up and exit

 K APCDY,APCDEREC,APCDPRV,APCDE

 Q

ERR ;

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

 D ERR^APCDRV

 Q

PRI200 ;IHS/CMI/LAB - patch 1 for file 200 converted sites

 S APCDEREC=^AUPNVPRV(APCDEDFN,0),APCDPRV=$P(APCDEREC,U),APCDY=""

 I '$D(^VA(200,APCDPRV)) S APCDE="E002" D ERR G XIT

 I '$D(^VA(200,APCDPRV,9999999)) S APCDE="E002" D ERR G XIT

 I $$PROVAFFL^XBFUNC1(APCDPRV,"I")="" S APCDE="E028" D ERR G XIT

 I $$PROVCLS^XBFUNC1(APCDPRV,"I")="UNKNOWN" S APCDE="E027" D ERR G XIT

 I $$PROVCODE^XBFUNC1(APCDPRV)="" S APCDE="E002" D ERR G XIT

 ;

 Q

APCDR06   ; IHS/CMI/LAB - V PROVIDER REVIEW ;

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

 +2       ;

 +3       ;IHS/CMI/LAB patch 1 for file 200 converted sites

PRIPRV    ; 

 +1        IF $PIECE(^DD(9000010.06,.01,0),U,2)[200

               DO PRI200

               GOTO XIT

 +2        SET APCDEREC=^AUPNVPRV(APCDEDFN,0)

           SET APCDPRV=$PIECE(APCDEREC,U)

           SET APCDY=""

 +3        IF '$DATA(^DIC(6,APCDPRV))

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +4        IF '$DATA(^DIC(6,APCDPRV,9999999))

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +5        IF $PIECE(^DIC(6,APCDPRV,9999999),U)=""

               SET APCDE="E028"

               DO ERR

               GOTO XIT

 +6        SET APCDY=$PIECE(^DIC(6,APCDPRV,0),U,4)

 +7        IF APCDY=""

               SET APCDE="E027"

               DO ERR

               GOTO XIT

 +8        IF '$DATA(^DIC(7,APCDY,9999999))

               SET APCDE="E027"

               DO ERR

               GOTO XIT

 +9        IF $PIECE(^DIC(7,APCDY,9999999),U)=""

               SET APCDE="E027"

               DO ERR

               GOTO XIT

 +10       IF $PIECE(^DIC(6,APCDPRV,9999999),U,2)=""

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +11      ;

XIT       ; Clean up and exit

 +1        KILL APCDY,APCDEREC,APCDPRV,APCDE

 +2        QUIT 

ERR       ;

 +1        SET APCDE("FILE")=9000010.06

           SET APCDE("ENTRY")=APCDEDFN

 +2        DO ERR^APCDRV

 +3        QUIT 

PRI200    ;IHS/CMI/LAB - patch 1 for file 200 converted sites

 +1        SET APCDEREC=^AUPNVPRV(APCDEDFN,0)

           SET APCDPRV=$PIECE(APCDEREC,U)

           SET APCDY=""

 +2        IF '$DATA(^VA(200,APCDPRV))

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +3        IF '$DATA(^VA(200,APCDPRV,9999999))

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +4        IF $$PROVAFFL^XBFUNC1(APCDPRV,"I")=""

               SET APCDE="E028"

               DO ERR

               GOTO XIT

 +5        IF $$PROVCLS^XBFUNC1(APCDPRV,"I")="UNKNOWN"

               SET APCDE="E027"

               DO ERR

               GOTO XIT

 +6        IF $$PROVCODE^XBFUNC1(APCDPRV)=""

               SET APCDE="E002"

               DO ERR

               GOTO XIT

 +7       ;

 +8        QUIT