- APCDR07 ; IHS/CMI/LAB - V POV REVIEW ;
- ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- ;
- ; screening off codes less than 800.
- DVAR ;
- S APCDEREC=^AUPNVPOV(APCDEDFN,0)
- POVCODE ;
- S APCDICDP=$P(APCDEREC,U) I '$D(^ICD9(APCDICDP,0)) S APCDE="E004" D ERR G XIT
- S APCDICD=$$CODEC^ICDEX(80,APCDICDP)
- K APCDE,APCDAGEE
- D ^APCDRICD
- I $D(APCDE) D ERR G XIT
- I $D(APCDAGEE),'$P(^AUPNVPOV(APCDEDFN,0),U,14) S APCDE="E048" D ERR G XIT
- S APCDCODE=APCDICD
- POVNARR ; POV Narrative-CP 51-94- if null use 3rd piece of ICD9
- S APCDNPTR=$P(APCDEREC,U,4) I APCDNPTR="" S APCDE="E006" D ERR G XIT
- I '$D(^AUTNPOV(APCDNPTR,0)) S APCDE="E006" D ERR G XIT
- ;
- FVRV ; First/Revisit-CP 95-8th piece of AUPNVPOV,0
- S APCDFVRV=$P(APCDEREC,U,8)
- S:APCDFVRV="" APCDFVRV=2
- ;
- INJICDA ; Cause of Injury-CP 106-109
- S APCDICD="",APCDINJ=$P(APCDEREC,U,11),APCDICDP=$P(APCDEREC,U,9)
- G:APCDICDP="" XIT
- G:'$$INJ^APCDAPOV($$CODEC^ICDEX(80,APCDICDP),$$CSI^ICDEX(80,APCDICDP)) XIT
- I '$$CHKE1^AUPNSICD(APCDICDP) S APCDE="E005" D ERR G XIT
- ;
- XIT ; Clean up and exit
- K APCDEREC,APCDICD,APCDICDP,APCDNPTR,APCDINJ,APCDE,APCDCODE,APCDFVRV,APCDAGEE
- Q
- ERR ;
- S APCDE("FILE")=9000010.07,APCDE("ENTRY")=APCDEDFN
- D ERR^APCDRV
- Q
- APCDR07 ; IHS/CMI/LAB - V POV REVIEW ;
- +1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
- +2 ;
- +3 ; screening off codes less than 800.
- DVAR ;
- +1 SET APCDEREC=^AUPNVPOV(APCDEDFN,0)
- POVCODE ;
- +1 SET APCDICDP=$PIECE(APCDEREC,U)
- IF '$DATA(^ICD9(APCDICDP,0))
- SET APCDE="E004"
- DO ERR
- GOTO XIT
- +2 SET APCDICD=$$CODEC^ICDEX(80,APCDICDP)
- +3 KILL APCDE,APCDAGEE
- +4 DO ^APCDRICD
- +5 IF $DATA(APCDE)
- DO ERR
- GOTO XIT
- +6 IF $DATA(APCDAGEE)
- IF '$PIECE(^AUPNVPOV(APCDEDFN,0),U,14)
- SET APCDE="E048"
- DO ERR
- GOTO XIT
- +7 SET APCDCODE=APCDICD
- POVNARR ; POV Narrative-CP 51-94- if null use 3rd piece of ICD9
- +1 SET APCDNPTR=$PIECE(APCDEREC,U,4)
- IF APCDNPTR=""
- SET APCDE="E006"
- DO ERR
- GOTO XIT
- +2 IF '$DATA(^AUTNPOV(APCDNPTR,0))
- SET APCDE="E006"
- DO ERR
- GOTO XIT
- +3 ;
- FVRV ; First/Revisit-CP 95-8th piece of AUPNVPOV,0
- +1 SET APCDFVRV=$PIECE(APCDEREC,U,8)
- +2 IF APCDFVRV=""
- SET APCDFVRV=2
- +3 ;
- INJICDA ; Cause of Injury-CP 106-109
- +1 SET APCDICD=""
- SET APCDINJ=$PIECE(APCDEREC,U,11)
- SET APCDICDP=$PIECE(APCDEREC,U,9)
- +2 IF APCDICDP=""
- GOTO XIT
- +3 IF '$$INJ^APCDAPOV($$CODEC^ICDEX(80,APCDICDP),$$CSI^ICDEX(80,APCDICDP))
- GOTO XIT
- +4 IF '$$CHKE1^AUPNSICD(APCDICDP)
- SET APCDE="E005"
- DO ERR
- GOTO XIT
- +5 ;
- XIT ; Clean up and exit
- +1 KILL APCDEREC,APCDICD,APCDICDP,APCDNPTR,APCDINJ,APCDE,APCDCODE,APCDFVRV,APCDAGEE
- +2 QUIT
- ERR ;
- +1 SET APCDE("FILE")=9000010.07
- SET APCDE("ENTRY")=APCDEDFN
- +2 DO ERR^APCDRV
- +3 QUIT
