APCDR07.m

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