ABMDVST3.m

ABMDVST3 ; IHS/ASDST/DMJ - PCC VISIT STUFF - PART 4 (ICD PROCEDURE) ; 

 ;;2.6;IHS 3P BILLING SYSTEM;**14,16**;NOV 12, 2009;Build 268

 ;;Y2K/OK - IHS/ADC/JLG 12-18-97

 ;Original;TMD;03/26/96 12:26 PM

 ;

 ;IHS/SD/SDR - 2.6*14 - ICD10 - 002H - ICD10 changes, including 1st SNOMED code for V Procedure

 ;IHS/SD/SDR - 2.6*16 - HEAT214025 - Dual-coding fields weren't being looked at for the transition from

 ;   ICD9 to ICD10.

 ;

 Q:ABMIDONE

 ; undinumed

PRC ;

 S DA(1)=ABMP("CDFN")

 S DIC="^ABMDCLM(DUZ(2),"_DA(1)_",19,"

 S DIC(0)="LE"

 ;S ABMR("P")=2  ;abm*2.6*14 ICD10 002H

 S ABMR("P")=1  ;abm*2.6*14 ICD10 002H

 S ABMI=""

 F  S ABMI=$O(^AUPNVPRC("AD",ABMVDFN,ABMI)) Q:'ABMI  D

 .K DIC("DR"),DD,DO

 .D PRCCHK

 K ABMR,ABMI,ABMSRC,DIC

 Q

 ;

PRCCHK ;

 Q:'$D(^AUPNVPRC(ABMI,0))

 N ABMOKNEW,ABMEDIT

 S ABMEDIT=0

 ;Set to 1 or 2, 7th piece is principle proc

 S ABMR("PX")=$S($P(^AUPNVPRC(ABMI,0),U,7)="Y":1,1:ABMR("P"))

 S ABMTYP=$S($P($$ICDOP^ABMCVAPI($P(^AUPNVPRC(ABMI,0),U),ABMP("VDT")),U,15)=31:"ICD10",1:"ICD9")  ;abm*2.6*14 ICD10 002F

 ;Sets the 2 vars to the last value of the subscript+1

 I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABMR("PX")))=10 S ABMR="" F  S ABMR=$O(^(ABMR)) Q:ABMR=""  S (ABMR("PX"),ABMR("P"))=ABMR+1

 ;Sets var to procedure date if it exists or to visit date

 S ABMR("VDT")=$S($P(^AUPNVPRC(ABMI,0),U,6)]"":$P(^(0),U,6),1:ABMCHVDT)

 ;Diagnosis

 ;S ABMR("CDX")=$S($P(^AUPNVPRC(X,0),U,5)]"":$P(^(0),U,5),1:"")

 S ABMSRC="08|"_ABMI_"|ICD"

 ; setting prov narrative

 S X=$P(^AUPNVPRC(ABMI,0),U)

 I +$P(^AUPNVPRC(ABMI,0),U,22)'=0&(ABMP("ICD10")>ABMP("VDT")) S X=+$P(^AUPNVPRC(ABMI,0),U,22),ABMTYP="ICD9"  ;abm*2.6*16 HEAT214025

 S ABMR("NAR")=$P(^AUPNVPRC(ABMI,0),U,4)

 I '$D(@(DIC_"0)")) S @(DIC_"0)")="^9002274.3019P",ABMOKNEW=1

 E  D

 .S ABMOKNEW=1

 .S ABM=0

 .F  S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM)) Q:'ABM  D  Q:'ABMOKNEW

 ..S Y=$G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM,0))

 ..;S ABMTYP=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM,0)),U,6)=1:"ICD10",1:"ICD9")  ;abm*2.6*14 ICD10 002H

 ..Q:($P(Y,U,17)]"")&(ABMSRC'=$P(Y,U,17))

 ..I $P(Y,U,17)="",X'=$P(Y,U) Q

 ..S ABMOKNEW=0

 ..I (X'=$P(Y,U))!(ABMR("VDT")'=$P(Y,U,3))!(ABMR("NAR")'=$P(Y,U,4)) S ABMEDIT=1 Q

 ..I $P(Y,U,17)="",X=$P(Y,U) S ABMEDIT=1

 I ABMOKNEW D  Q

 .;S DIC("DR")=".02////"_ABMR("PX")_";.03////"_ABMR("VDT")_";.04////"_ABMR("NAR")  ;abm*2.6*14 ICD10 002H

 .I (ABMP("ICD10")<ABMP("VDT")!(ABMP("ICD10")=ABMP("VDT")))&(ABMTYP="ICD10") S DIC("DR")=".02////"_ABMR("PX")  ;abm*2.6*14 ICD10 002H

 .I (ABMP("ICD10")>ABMP("VDT")&(ABMTYP="ICD9")) S DIC("DR")=".02////"_ABMR("PX")  ;abm*2.6*14 ICD10 002H

 .S DIC("DR")=$S($G(DIC("DR"))'="":DIC("DR")_";",1:"")_".03////"_ABMR("VDT")_";.04////"_ABMR("NAR")  ;abm*2.6*14 ICD10 002H

 .;S:ABMR("CDX")]"" DIC("DR")=DIC("DR")_";.05////"_ABMR("CDX")

 .S:(ABMTYP="ICD10") DIC("DR")=DIC("DR")_";.06////1"  ;abm*2.6*14 ICD10 002H

 .I ABMTYP="ICD10"&(+$P(^AUPNVPRC(ABMI,0),U,22)) S DIC("DR")=DIC("DR")_";21////"_+$P(^AUPNVPRC(ABMI,0),U,22)_";22////"_+$P(^AUPNVPRC(ABMI,0),U,23)  ;abm*2.6*16 IHS/SD/SDR HEAT214025

 .S DIC("DR")=DIC("DR")_";.17////"_ABMSRC

 .;S:ABMR("PX")>1 ABMR("P")=ABMR("P")+1  ;abm*2.6*14 ICD10 002H

 .I ABMP("ICD10")<ABMP("VDT")!(ABMP("ICD10")=ABMP("VDT")),ABMR("PX")>1 S ABMR("P")=ABMR("P")+1  ;abm*2.6*14 ICD10 002H

 .K DD,DO D FILE^DICN

 I ABMEDIT D

 .N FILE,IENS,ABMFDA

 .S FILE=9002274.3019

 .S IENS=ABM_","_ABMP("CDFN")_","

 .S ABMFDA(FILE,IENS,.01)=X

 .S ABMFDA(FILE,IENS,.03)=ABMR("VDT")

 .S ABMFDA(FILE,IENS,.04)=ABMR("NAR")

 .I $P($$ICDOP^ABMCVAPI(X,ABMP("VDT")),U,15)=31 S ABMFDA(FILE,IENS,.06)=1  ;abm*2.6*14 ICD10 002H

 .S ABMFDA(FILE,IENS,.17)=ABMSRC

 .D FILE^DIE("K","ABMFDA")

 D VPRCSNOM  ;abm*2.6*14 ICD10 SNOMED

 Q

 ;start new abm*2.6*14 ICD10 SNOMED

VPRCSNOM ;EP

 S ABMII=+$O(^AUPNVPRC(ABMI,26,0))

 I ABMII=0 Q

 S IENS=ABMII_","_ABMI_","

 S X=$$GET1^DIQ(9000010.0826,IENS,".01","I")

 Q:X=""

 S DA(1)=ABMP("CDFN")

 S DA=ABM

 S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",19,"

 S DR="11////"_X

 D ^DIE

 Q

 ;end new ICD10 SNOMED

ABMDVST3  ; IHS/ASDST/DMJ - PCC VISIT STUFF - PART 4 (ICD PROCEDURE) ; 

 +1       ;;2.6;IHS 3P BILLING SYSTEM;**14,16**;NOV 12, 2009;Build 268

 +2       ;;Y2K/OK - IHS/ADC/JLG 12-18-97

 +3       ;Original;TMD;03/26/96 12:26 PM

 +4       ;

 +5       ;IHS/SD/SDR - 2.6*14 - ICD10 - 002H - ICD10 changes, including 1st SNOMED code for V Procedure

 +6       ;IHS/SD/SDR - 2.6*16 - HEAT214025 - Dual-coding fields weren't being looked at for the transition from

 +7       ;   ICD9 to ICD10.

 +8       ;

 +9        IF ABMIDONE

               QUIT 

 +10      ; undinumed

PRC       ;

 +1        SET DA(1)=ABMP("CDFN")

 +2        SET DIC="^ABMDCLM(DUZ(2),"_DA(1)_",19,"

 +3        SET DIC(0)="LE"

 +4       ;S ABMR("P")=2  ;abm*2.6*14 ICD10 002H

 +5       ;abm*2.6*14 ICD10 002H

           SET ABMR("P")=1

 +6        SET ABMI=""

 +7        FOR 

               SET ABMI=$ORDER(^AUPNVPRC("AD",ABMVDFN,ABMI))

               IF 'ABMI

                   QUIT 

               Begin DoDot:1

 +8                KILL DIC("DR"),DD,DO

 +9                DO PRCCHK

               End DoDot:1

 +10       KILL ABMR,ABMI,ABMSRC,DIC

 +11       QUIT 

 +12      ;

PRCCHK    ;

 +1        IF '$DATA(^AUPNVPRC(ABMI,0))

               QUIT 

 +2        NEW ABMOKNEW,ABMEDIT

 +3        SET ABMEDIT=0

 +4       ;Set to 1 or 2, 7th piece is principle proc

 +5        SET ABMR("PX")=$SELECT($PIECE(^AUPNVPRC(ABMI,0),U,7)="Y":1,1:ABMR("P"))

 +6       ;abm*2.6*14 ICD10 002F

           SET ABMTYP=$SELECT($PIECE($$ICDOP^ABMCVAPI($PIECE(^AUPNVPRC(ABMI,0),U),ABMP("VDT")),U,15)=31:"ICD10",1:"ICD9")

 +7       ;Sets the 2 vars to the last value of the subscript+1

 +8        IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABMR("PX")))=10

               SET ABMR=""

               FOR 

                   SET ABMR=$ORDER(^(ABMR))

                   IF ABMR=""

                       QUIT 

                   SET (ABMR("PX"),ABMR("P"))=ABMR+1

 +9       ;Sets var to procedure date if it exists or to visit date

 +10       SET ABMR("VDT")=$SELECT($PIECE(^AUPNVPRC(ABMI,0),U,6)]"":$PIECE(^(0),U,6),1:ABMCHVDT)

 +11      ;Diagnosis

 +12      ;S ABMR("CDX")=$S($P(^AUPNVPRC(X,0),U,5)]"":$P(^(0),U,5),1:"")

 +13       SET ABMSRC="08|"_ABMI_"|ICD"

 +14      ; setting prov narrative

 +15       SET X=$PIECE(^AUPNVPRC(ABMI,0),U)

 +16      ;abm*2.6*16 HEAT214025

           IF +$PIECE(^AUPNVPRC(ABMI,0),U,22)'=0&(ABMP("ICD10")>ABMP("VDT"))

               SET X=+$PIECE(^AUPNVPRC(ABMI,0),U,22)

               SET ABMTYP="ICD9"

 +17       SET ABMR("NAR")=$PIECE(^AUPNVPRC(ABMI,0),U,4)

 +18       IF '$DATA(@(DIC_"0)"))

               SET @(DIC_"0)")="^9002274.3019P"

               SET ABMOKNEW=1

 +19      IF '$TEST

               Begin DoDot:1

 +20               SET ABMOKNEW=1

 +21               SET ABM=0

 +22               FOR 

                       SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM))

                       IF 'ABM

                           QUIT 

                       Begin DoDot:2

 +23                       SET Y=$GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM,0))

 +24      ;S ABMTYP=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,ABM,0)),U,6)=1:"ICD10",1:"ICD9")  ;abm*2.6*14 ICD10 002H

 +25                       IF ($PIECE(Y,U,17)]"")&(ABMSRC'=$PIECE(Y,U,17))

                               QUIT 

 +26                       IF $PIECE(Y,U,17)=""

                               IF X'=$PIECE(Y,U)

                                   QUIT 

 +27                       SET ABMOKNEW=0

 +28                       IF (X'=$PIECE(Y,U))!(ABMR("VDT")'=$PIECE(Y,U,3))!(ABMR("NAR")'=$PIECE(Y,U,4))

                               SET ABMEDIT=1

                               QUIT 

 +29                       IF $PIECE(Y,U,17)=""

                               IF X=$PIECE(Y,U)

                                   SET ABMEDIT=1

                       End DoDot:2

                       IF 'ABMOKNEW

                           QUIT 

               End DoDot:1

 +30       IF ABMOKNEW

               Begin DoDot:1

 +31      ;S DIC("DR")=".02////"_ABMR("PX")_";.03////"_ABMR("VDT")_";.04////"_ABMR("NAR")  ;abm*2.6*14 ICD10 002H

 +32      ;abm*2.6*14 ICD10 002H

                   IF (ABMP("ICD10")<ABMP("VDT")!(ABMP("ICD10")=ABMP("VDT")))&(ABMTYP="ICD10")

                       SET DIC("DR")=".02////"_ABMR("PX")

 +33      ;abm*2.6*14 ICD10 002H

                   IF (ABMP("ICD10")>ABMP("VDT")&(ABMTYP="ICD9"))

                       SET DIC("DR")=".02////"_ABMR("PX")

 +34      ;abm*2.6*14 ICD10 002H

                   SET DIC("DR")=$SELECT($GET(DIC("DR"))'="":DIC("DR")_";",1:"")_".03////"_ABMR("VDT")_";.04////"_ABMR("NAR")

 +35      ;S:ABMR("CDX")]"" DIC("DR")=DIC("DR")_";.05////"_ABMR("CDX")

 +36      ;abm*2.6*14 ICD10 002H

                   IF (ABMTYP="ICD10")

                       SET DIC("DR")=DIC("DR")_";.06////1"

 +37      ;abm*2.6*16 IHS/SD/SDR HEAT214025

                   IF ABMTYP="ICD10"&(+$PIECE(^AUPNVPRC(ABMI,0),U,22))

                       SET DIC("DR")=DIC("DR")_";21////"_+$PIECE(^AUPNVPRC(ABMI,0),U,22)_";22////"_+$PIECE(^AUPNVPRC(ABMI,0),U,23)

 +38               SET DIC("DR")=DIC("DR")_";.17////"_ABMSRC

 +39      ;S:ABMR("PX")>1 ABMR("P")=ABMR("P")+1  ;abm*2.6*14 ICD10 002H

 +40      ;abm*2.6*14 ICD10 002H

                   IF ABMP("ICD10")<ABMP("VDT")!(ABMP("ICD10")=ABMP("VDT"))

                       IF ABMR("PX")>1

                           SET ABMR("P")=ABMR("P")+1

 +41               KILL DD,DO

                   DO FILE^DICN

               End DoDot:1

               QUIT 

 +42       IF ABMEDIT

               Begin DoDot:1

 +43               NEW FILE,IENS,ABMFDA

 +44               SET FILE=9002274.3019

 +45               SET IENS=ABM_","_ABMP("CDFN")_","

 +46               SET ABMFDA(FILE,IENS,.01)=X

 +47               SET ABMFDA(FILE,IENS,.03)=ABMR("VDT")

 +48               SET ABMFDA(FILE,IENS,.04)=ABMR("NAR")

 +49      ;abm*2.6*14 ICD10 002H

                   IF $PIECE($$ICDOP^ABMCVAPI(X,ABMP("VDT")),U,15)=31

                       SET ABMFDA(FILE,IENS,.06)=1

 +50               SET ABMFDA(FILE,IENS,.17)=ABMSRC

 +51               DO FILE^DIE("K","ABMFDA")

               End DoDot:1

 +52      ;abm*2.6*14 ICD10 SNOMED

           DO VPRCSNOM

 +53       QUIT 

 +54      ;start new abm*2.6*14 ICD10 SNOMED

VPRCSNOM  ;EP

 +1        SET ABMII=+$ORDER(^AUPNVPRC(ABMI,26,0))

 +2        IF ABMII=0

               QUIT 

 +3        SET IENS=ABMII_","_ABMI_","

 +4        SET X=$$GET1^DIQ(9000010.0826,IENS,".01","I")

 +5        IF X=""

               QUIT 

 +6        SET DA(1)=ABMP("CDFN")

 +7        SET DA=ABM

 +8        SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",19,"

 +9        SET DR="11////"_X

 +10       DO ^DIE

 +11       QUIT 

 +12      ;end new ICD10 SNOMED