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
