ABMDE0X1 ; IHS/ASDST/DMJ - Set Summary Display Variables ;
;;2.6;IHS 3P BILLING SYSTEM;**14,19,21**;NOV 12, 2009;Build 379
;
; IHS/DSD/LSL - 05/18/98 - NOIS QBA-0598-130045
; Get error 004 - Claim has no charges or procedures to
; bill when items exist only on page 8J (Charge Master).
;
; IHS/SD/SDR - v2.5 p8 - task 6
; Added code for new ambulance multiple (47)
;
; IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - ICD10 008 - warning if Service Date cross over ICD10 EFFECTIVE DATE
;IHS/SD/SDR - 2.6*19 - HEAT109144 - Made change to 72-hr check so it will work for error 255 as well as 191.
;IHS/SD/SDR - 2.6*21 - VMBP RQMT_92 - Added warning 254 to page0 if active insurer has insurer type 'V' and
; there are entries in V Med file.
;
; *********************************************************************
I ABMP("PX")="C" D CPT
I ABMP("PX")="I" D PX
D 72
N I
F I=1:1 Q:'$D(ABM("P"_I)) S ABM("P"_I)=$TR(ABM("P"_I),"""","'")
S ABMP("SDF")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U) ;abm*2.6*14 ICD10 008
S ABMP("SDT")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2) ;abm*2.6*14 ICD10 008
I (ABMP("ICD10")>ABMP("SDF"))&(ABMP("ICD10")<ABMP("SDT")) S ABME(249)="" ;abm*2.6*14 ICD10 008
I ABMP("VDT")>ABMP("ICD10") S ABME(250)="" ;abm*2.6*14 ICD10 008C
;start new code abm*2.6*14 ICD10 027A
S ABM=0
F S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:'ABM D
.S ABMI=0
.F S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM,ABMI)) Q:'ABMI D
..S ABMCS=+$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI,0),U,6)
..S ABM("ABMCS",ABMCS)=+$G(ABM("ABMCS",ABMCS))+1
I ABMP("ICD10")>ABMP("VDT"),+$G(ABM("ABMCS",0))=0 S ABME(251)=""
I ABMP("ICD10")<ABMP("VDT"),+$G(ABM("ABMCS",1))=0 S ABME(251)=""
;end new code ICD10 027A
I +$G(ABMVIEN)'=0,$D(^AUPNVMED("AD",ABMVIEN))&($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="V") S ABME(254)="" ;abm*2.6*21 VMBP RQMT_92
;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
D FIND^DIC(9999999.18,"","@;.01;.211","CP","V","*",,"I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,Y,"".211"",""I""),1,""I"")=""V""","","ABMIL")
I +$O(ABMIL("DILIST",0))=0 S ABME(252)=""
;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
Q
;
; *********************************************************************
PX ;
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM)) Q:ABM="" D
.S Y=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM,0))
.S ABMICD0=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,Y,0),U)
.S ABM("P"_ABM("I"))=$E($P($$ICDOP^ABMCVAPI(ABMICD0,ABMP("VDT")),U,5),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")
Q
;
; *********************************************************************
CPT ;EP - Entry Point for setting up display array
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM)) Q:ABM="" D
.S Y=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM,""))
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,Y,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")
S ABM=0
F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(+Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
S ABM=0
F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
S ABM=0
F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
S ABM=0
F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
S ABM=0
F ABM("I")=ABM("I"):1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34) ;CSV-c
S ABM("CNT2")=ABM("CNT2")+ABM("I")-1
I '$D(ABM("P1")) D
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0))
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,0))
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,0))
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,0))
.Q:$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,0))
.S ABME(4)=""
Q
72 ;check 72 hour rule
;Q:'$$IN72H^ABMDVCK0(ABMP("CDFN")) ;abm*2.6*19 IHS/SD/SDR HEAT109144
;S ABME(191)="" ;abm*2.6*19 IHS/SD/SDR HEAT109144
S ABM72=$$IN72H^ABMDVCK0(ABMP("CDFN")) ;abm*2.6*19 IHS/SD/SDR HEAT109144
I ABM72=1 S ABME(191)="" ;abm*2.6*19 IHS/SD/SDR HEAT109144
I ABM72=2 S ABME(255)="" ;abm*2.6*19 IHS/SD/SDR HEAT109144
Q
ABMDE0X1 ; IHS/ASDST/DMJ - Set Summary Display Variables ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14,19,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; IHS/DSD/LSL - 05/18/98 - NOIS QBA-0598-130045
+4 ; Get error 004 - Claim has no charges or procedures to
+5 ; bill when items exist only on page 8J (Charge Master).
+6 ;
+7 ; IHS/SD/SDR - v2.5 p8 - task 6
+8 ; Added code for new ambulance multiple (47)
+9 ;
+10 ; IHS/SD/SDR - v2.6 CSV
+11 ;IHS/SD/SDR - 2.6*14 - ICD10 008 - warning if Service Date cross over ICD10 EFFECTIVE DATE
+12 ;IHS/SD/SDR - 2.6*19 - HEAT109144 - Made change to 72-hr check so it will work for error 255 as well as 191.
+13 ;IHS/SD/SDR - 2.6*21 - VMBP RQMT_92 - Added warning 254 to page0 if active insurer has insurer type 'V' and
+14 ; there are entries in V Med file.
+15 ;
+16 ; *********************************************************************
+17 IF ABMP("PX")="C"
DO CPT
+18 IF ABMP("PX")="I"
DO PX
+19 DO 72
+20 NEW I
+21 FOR I=1:1
IF '$DATA(ABM("P"_I))
QUIT
SET ABM("P"_I)=$TRANSLATE(ABM("P"_I),"""","'")
+22 ;abm*2.6*14 ICD10 008
SET ABMP("SDF")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
+23 ;abm*2.6*14 ICD10 008
SET ABMP("SDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)
+24 ;abm*2.6*14 ICD10 008
IF (ABMP("ICD10")>ABMP("SDF"))&(ABMP("ICD10")<ABMP("SDT"))
SET ABME(249)=""
+25 ;abm*2.6*14 ICD10 008C
IF ABMP("VDT")>ABMP("ICD10")
SET ABME(250)=""
+26 ;start new code abm*2.6*14 ICD10 027A
+27 SET ABM=0
+28 FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+29 SET ABMI=0
+30 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM,ABMI))
IF 'ABMI
QUIT
Begin DoDot:2
+31 SET ABMCS=+$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,ABMI,0),U,6)
+32 SET ABM("ABMCS",ABMCS)=+$GET(ABM("ABMCS",ABMCS))+1
End DoDot:2
End DoDot:1
+33 IF ABMP("ICD10")>ABMP("VDT")
IF +$GET(ABM("ABMCS",0))=0
SET ABME(251)=""
+34 IF ABMP("ICD10")<ABMP("VDT")
IF +$GET(ABM("ABMCS",1))=0
SET ABME(251)=""
+35 ;end new code ICD10 027A
+36 ;abm*2.6*21 VMBP RQMT_92
IF +$GET(ABMVIEN)'=0
IF $DATA(^AUPNVMED("AD",ABMVIEN))&($$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="V")
SET ABME(254)=""
+37 ;start new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+38 DO FIND^DIC(9999999.18,"","@;.01;.211","CP","V","*",,"I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,Y,"".211"",""I""),1,""I"")=""V""","","ABMIL")
+39 IF +$ORDER(ABMIL("DILIST",0))=0
SET ABME(252)=""
+40 ;end new abm*2.6*21 IHS/SD/SDR VMBP RQMT_90
+41 QUIT
+42 ;
+43 ; *********************************************************************
PX ;
+1 SET ABM=""
+2 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM))
IF ABM=""
QUIT
Begin DoDot:1
+3 SET Y=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,"C",ABM,0))
+4 SET ABMICD0=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),19,Y,0),U)
+5 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$ICDOP^ABMCVAPI(ABMICD0,ABMP("VDT")),U,5),1,34)
End DoDot:1
+6 SET ABM("CNT2")=ABM("CNT2")+ABM("I")
+7 QUIT
+8 ;
+9 ; *********************************************************************
CPT ;EP - Entry Point for setting up display array
+1 SET ABM=""
+2 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM))
IF ABM=""
QUIT
Begin DoDot:1
+3 SET Y=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,"C",ABM,""))
+4 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,Y,0),U)
+5 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+6 SET ABM("CNT2")=ABM("CNT2")+ABM("I")
+7 SET ABM=0
+8 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+9 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),27,ABM,0),U)
+10 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(+Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+11 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+12 SET ABM=0
+13 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+14 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,0),U)
+15 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+16 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+17 SET ABM=0
+18 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+19 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM,0),U)
+20 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+21 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+22 SET ABM=0
+23 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+24 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,ABM,0),U)
+25 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+26 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+27 SET ABM=0
+28 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+29 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),43,ABM,0),U)
+30 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+31 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+32 IF '$DATA(ABM("P1"))
Begin DoDot:1
+33 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),25,0))
QUIT
+34 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),23,0))
QUIT
+35 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,0))
QUIT
+36 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),45,0))
QUIT
+37 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),47,0))
QUIT
+38 SET ABME(4)=""
End DoDot:1
+39 QUIT
72 ;check 72 hour rule
+1 ;Q:'$$IN72H^ABMDVCK0(ABMP("CDFN")) ;abm*2.6*19 IHS/SD/SDR HEAT109144
+2 ;S ABME(191)="" ;abm*2.6*19 IHS/SD/SDR HEAT109144
+3 ;abm*2.6*19 IHS/SD/SDR HEAT109144
SET ABM72=$$IN72H^ABMDVCK0(ABMP("CDFN"))
+4 ;abm*2.6*19 IHS/SD/SDR HEAT109144
IF ABM72=1
SET ABME(191)=""
+5 ;abm*2.6*19 IHS/SD/SDR HEAT109144
IF ABM72=2
SET ABME(255)=""
+6 QUIT
