- APCDR08 ; IHS/CMI/LAB - V PROCEDURE REVIEW ;
- ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- ;
- S APCDEREC=^AUPNVPRC(APCDEDFN,0)
- OPCODE ; Operation Code-CP 94-97
- S APCDOPTR=$P(APCDEREC,U),APCDNPTR=$P(APCDEREC,U,4)
- I APCDOPTR="" S APCDE="E007" D ERR G XIT
- I '$D(^ICD0(APCDOPTR,0)) S APCDE="E007" D ERR G XIT
- S APCDOP=$$CODEC^ICDEX(80.1,APCDOPTR)
- I APCDOP=.9999!(APCDOP="ZZZ999") S APCDE="E032" D ERR G XIT
- ;I $L($P(APCDOP,".",2))>2 S APCDE="E003" D ERR G XIT
- I $P($$ICDOP^ICDEX(APCDOPTR,$$VD^APCLV(APCDVSIT),,"I"),U,11)]"",AUPNSEX'=$P($$ICDOP^ICDEX(APCDOPTR,$$VD^APCLV(APCDVSIT),,"I"),U,11) S APCDE="E043" D ERR G XIT
- I $$VERSION^XPDUTL("BCSV")]"" G OPNARR ;no age edits in csv
- G:'$D(^ICD0($P(APCDEREC,U),9999999)) OPNARR
- I $P(^ICD0($P(APCDEREC,U),9999999),U,2)]"",($P(^ICD0($P(APCDEREC,U),9999999),U,2)<AUPNDAYS),'$D(APCDACC) S APCDE="E036" D ERR G XIT
- I $P(^ICD0($P(APCDEREC,U),9999999),U)]"",($P(^ICD0($P(APCDEREC,U),9999999),U)>AUPNDAYS),'$D(APCDACC) S APCDE="E036" D ERR G XIT
- ;
- OPNARR ; Operation Narrative-CP 50-93
- I APCDNPTR="" S APCDE="E006" D ERR G XIT
- I '$D(^AUTNPOV(APCDNPTR,0)) S APCDE="E006" D ERR G XIT
- ;
- DXPRFM ; Diagnosis for which Operation Performed. Char Pos 98-102.
- G:$P(APCDVREC,U,7)'="H" XIT
- S APCDICD="",APCDICDP=$P(APCDEREC,U,5) I APCDICDP="" S APCDE="E044" D ERR G XIT
- I '$D(^ICD9(APCDICDP,0)) S APCDE="E044" D ERR G XIT
- S APCDICD=$$CODEC^ICDEX(80,APCDICDP)
- K APCDE,APCDAGEE
- D ^APCDRICD
- I $D(APCDE) D ERR G XIT
- ;
- XIT ; Clean up and exit
- K APCDEREC,APCDNPTR,APCDOPTR,APCDICD,APCDAGEE,APCDICDP,APCDE,APCDOP
- Q
- ERR ;
- S APCDE("FILE")=9000010.08,APCDE("ENTRY")=APCDEDFN
- D ERR^APCDRV
- Q
- APCDR08 ; IHS/CMI/LAB - V PROCEDURE REVIEW ;
- +1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- +2 ;
- +3 SET APCDEREC=^AUPNVPRC(APCDEDFN,0)
- OPCODE ; Operation Code-CP 94-97
- +1 SET APCDOPTR=$PIECE(APCDEREC,U)
- SET APCDNPTR=$PIECE(APCDEREC,U,4)
- +2 IF APCDOPTR=""
- SET APCDE="E007"
- DO ERR
- GOTO XIT
- +3 IF '$DATA(^ICD0(APCDOPTR,0))
- SET APCDE="E007"
- DO ERR
- GOTO XIT
- +4 SET APCDOP=$$CODEC^ICDEX(80.1,APCDOPTR)
- +5 IF APCDOP=.9999!(APCDOP="ZZZ999")
- SET APCDE="E032"
- DO ERR
- GOTO XIT
- +6 ;I $L($P(APCDOP,".",2))>2 S APCDE="E003" D ERR G XIT
- +7 IF $PIECE($$ICDOP^ICDEX(APCDOPTR,$$VD^APCLV(APCDVSIT),,"I"),U,11)]""
- IF AUPNSEX'=$PIECE($$ICDOP^ICDEX(APCDOPTR,$$VD^APCLV(APCDVSIT),,"I"),U,11)
- SET APCDE="E043"
- DO ERR
- GOTO XIT
- +8 ;no age edits in csv
- IF $$VERSION^XPDUTL("BCSV")]""
- GOTO OPNARR
- +9 IF '$DATA(^ICD0($PIECE(APCDEREC,U),9999999))
- GOTO OPNARR
- +10 IF $PIECE(^ICD0($PIECE(APCDEREC,U),9999999),U,2)]""
- IF ($PIECE(^ICD0($PIECE(APCDEREC,U),9999999),U,2)<AUPNDAYS)
- IF '$DATA(APCDACC)
- SET APCDE="E036"
- DO ERR
- GOTO XIT
- +11 IF $PIECE(^ICD0($PIECE(APCDEREC,U),9999999),U)]""
- IF ($PIECE(^ICD0($PIECE(APCDEREC,U),9999999),U)>AUPNDAYS)
- IF '$DATA(APCDACC)
- SET APCDE="E036"
- DO ERR
- GOTO XIT
- +12 ;
- OPNARR ; Operation Narrative-CP 50-93
- +1 IF APCDNPTR=""
- SET APCDE="E006"
- DO ERR
- GOTO XIT
- +2 IF '$DATA(^AUTNPOV(APCDNPTR,0))
- SET APCDE="E006"
- DO ERR
- GOTO XIT
- +3 ;
- DXPRFM ; Diagnosis for which Operation Performed. Char Pos 98-102.
- +1 IF $PIECE(APCDVREC,U,7)'="H"
- GOTO XIT
- +2 SET APCDICD=""
- SET APCDICDP=$PIECE(APCDEREC,U,5)
- IF APCDICDP=""
- SET APCDE="E044"
- DO ERR
- GOTO XIT
- +3 IF '$DATA(^ICD9(APCDICDP,0))
- SET APCDE="E044"
- DO ERR
- GOTO XIT
- +4 SET APCDICD=$$CODEC^ICDEX(80,APCDICDP)
- +5 KILL APCDE,APCDAGEE
- +6 DO ^APCDRICD
- +7 IF $DATA(APCDE)
- DO ERR
- GOTO XIT
- +8 ;
- XIT ; Clean up and exit
- +1 KILL APCDEREC,APCDNPTR,APCDOPTR,APCDICD,APCDAGEE,APCDICDP,APCDE,APCDOP
- +2 QUIT
- ERR ;
- +1 SET APCDE("FILE")=9000010.08
- SET APCDE("ENTRY")=APCDEDFN
- +2 DO ERR^APCDRV
- +3 QUIT
