- 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
