ABMDE0X ; IHS/SD/SDR - Set Summary Display Variables ;
;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
;
;IHS/SD/SDR - v2.5 p8 - task 8 - Modified to check for replacement insurer to display
;
;IHS/SD/SDR - v2.6 CSV
;IHS/SD/SDR - 2.6*14 - HEAT161263 - Made change for display of provider narrative to use DIQ call so new output transform on field will be executed.
; *********************************************************************
IDEN ; EP
S ABM(1)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)
S ABM("CLN")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,6)
S ABM(2)=$S(ABM("CLN")]"":$P($G(^DIC(40.7,ABM("CLN"),0)),U,1),1:"")
S ABM(3)=$E($P(^ABMDVTYP($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7),0),U),1,26)
S ABM(4)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
S ABM(5)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)
S ABM(4)=$$HDT^ABMDUTL(ABM(4))
S ABM(5)=$$HDT^ABMDUTL(ABM(5))
;
INS ;
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM D
.S Y=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
.S ABM("I"_ABM("I")_"S")=" "_$S($P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,3)="I":"ACTIVE",$P(^(0),U,3)="C":"COMPLETE",$P(^(0),U,3)="B":"BILLED",$P(^(0),U,3)="U":"UNBILABL",1:"PENDING")
.S Y=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0)),U,11)'="":$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,11),1:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U))
.S ABM("I"_ABM("I"))=$P(^AUTNINS(Y,0),U)
;
QUES ;
S ABM("CNT1")=7+ABM("I")
D W1^ABMDE30
D W2^ABMDE30
S ABM("RELS")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y":"YES",1:"NO")
S ABM("ASGN")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",1:"NO")
S ABM("EMRG")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,5)="Y":"YES",1:"NO")
S ABM("EMPL")=$S($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,1)="Y":"YES",1:"NO")
S ABM("PROG")="NO"
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10 D
.S ABM("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
.I ABM("X")]"" D
..S ABM("X")=^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0)
..I $D(^ABMDCODE(ABM("X"),0)) D
...S ABM("PROG")="YES"
...S ABM("CNT1")=ABM("CNT1")+.5
S ABM("ACC")="NO"
I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)]""!($P($G(^(8)),U,3)]"") D
.S ABM("ACC")="YES"
.S ABM("CNT1")=ABM("CNT1")+.5
I ABM("EMRG")="YES" S ABM("CNT1")=ABM("CNT1")+.5
I ABM("EMPL")="YES" S ABM("CNT1")=ABM("CNT1")+.5
S ABM("CNT1")=ABM("CNT1")+.5
S ABM("CNT1")=$P(ABM("CNT1"),".")
;
PRV ;
K ABM("A"),ABM("O")
S (ABM("CNT2"),ABM("CNT3"))=1
S ABM=""
F S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM)) Q:ABM="" S ABM("X")=$O(^(ABM,"")),ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0) Q:$P(ABM("X0"),U,2)="" D
.I '$D(^VA(200,+ABM("X0"),0)) D Q
..S DA(1)=ABMP("CDFN")
..S DIK="^ABMDCLM(DUZ(2),"_DA(1)_",41,"
..S DA=ABM("X")
..D ^DIK
.S ABM($P(ABM("X0"),U,2))=$P(^VA(200,$P(ABM("X0"),U),0),U)
S ABM("OPRV")=$S($D(ABM("O")):ABM("O"),1:"")
I ABM("OPRV")]"" D
.S ABM("CNT2")=ABM("CNT2")+1
.S ABM("CNT3")=ABM("CNT3")+1
S ABM("APRV")=$S($D(ABM("A")):ABM("A"),1:"")
I ABM("OPRV")]"" D
.S ABM("CNT2")=ABM("CNT2")+1
.S ABM("CNT3")=ABM("CNT3")+1
;
DX ;
G DDS:ABMP("VTYP")=998&'$D(ABMP("FLAT"))
S ABM=""
;F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:ABM="" S Y=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$O(^(ABM,"")),0)),U,3) I Y]"" S ABM("D"_ABM("I"))=$E($G(^AUTNPOV(Y,0)),1,34) ;abm*2.6*14 HEAT161263
;start new code abm*2.6*14 HEAT161263
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:ABM="" D
.S ABMI=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM,0))
.Q:ABMI=""
.S IENS=ABMI_","_ABMP("CDFN")_","
.S Y=$$GET1^DIQ(9002274.3017,IENS,".03","E")
.I Y]"" S ABM("D"_ABM("I"))=$E(Y,1,34)
;end new code HEAT161263
S ABM("CNT2")=ABM("CNT2")+ABM("I")
;
D ^ABMDE0X1
Q
;
; *********************************************************************
DDS ;
S ABM=0
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM)) Q:'ABM D
.S Y=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM,0),U)
.S ABM("P"_ABM("I"))=$E($P($G(^AUTTADA(Y,0)),U,2),1,34)
S ABM("CNT2")=ABM("CNT2")+ABM("I")
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
;
XIT ;
Q
ABMDE0X ; IHS/SD/SDR - Set Summary Display Variables ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**14**;NOV 12, 2009;Build 238
+2 ;
+3 ;IHS/SD/SDR - v2.5 p8 - task 8 - Modified to check for replacement insurer to display
+4 ;
+5 ;IHS/SD/SDR - v2.6 CSV
+6 ;IHS/SD/SDR - 2.6*14 - HEAT161263 - Made change for display of provider narrative to use DIQ call so new output transform on field will be executed.
+7 ; *********************************************************************
IDEN ; EP
+1 SET ABM(1)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)
+2 SET ABM("CLN")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,6)
+3 SET ABM(2)=$SELECT(ABM("CLN")]"":$PIECE($GET(^DIC(40.7,ABM("CLN"),0)),U,1),1:"")
+4 SET ABM(3)=$EXTRACT($PIECE(^ABMDVTYP($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7),0),U),1,26)
+5 SET ABM(4)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U)
+6 SET ABM(5)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,2)
+7 SET ABM(4)=$$HDT^ABMDUTL(ABM(4))
+8 SET ABM(5)=$$HDT^ABMDUTL(ABM(5))
+9 ;
INS ;
+1 SET ABM=""
+2 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+3 SET Y=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,0))
+4 SET ABM("I"_ABM("I")_"S")=" "_$SELECT($PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,3)="I":"ACTIVE",$PIECE(^(0),U,3)="C":"COMPLETE",$PIECE(^(0),U,3)="B":"BILLED",$PIECE(^(0),U,3)="U":"UNBILABL",1:"PENDING")
+5 SET Y=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0)),U,11)'="":$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U,11),1:$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,Y,0),U))
+6 SET ABM("I"_ABM("I"))=$PIECE(^AUTNINS(Y,0),U)
End DoDot:1
+7 ;
QUES ;
+1 SET ABM("CNT1")=7+ABM("I")
+2 DO W1^ABMDE30
+3 DO W2^ABMDE30
+4 SET ABM("RELS")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,4)="Y":"YES",1:"NO")
+5 SET ABM("ASGN")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),7)),U,5)="Y":"YES",1:"NO")
+6 SET ABM("EMRG")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,5)="Y":"YES",1:"NO")
+7 SET ABM("EMPL")=$SELECT($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U,1)="Y":"YES",1:"NO")
+8 SET ABM("PROG")="NO"
+9 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),59))=10
Begin DoDot:1
+10 SET ABM("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),59,0))
+11 IF ABM("X")]""
Begin DoDot:2
+12 SET ABM("X")=^ABMDCLM(DUZ(2),ABMP("CDFN"),59,ABM("X"),0)
+13 IF $DATA(^ABMDCODE(ABM("X"),0))
Begin DoDot:3
+14 SET ABM("PROG")="YES"
+15 SET ABM("CNT1")=ABM("CNT1")+.5
End DoDot:3
End DoDot:2
End DoDot:1
+16 SET ABM("ACC")="NO"
+17 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,2)]""!($PIECE($GET(^(8)),U,3)]"")
Begin DoDot:1
+18 SET ABM("ACC")="YES"
+19 SET ABM("CNT1")=ABM("CNT1")+.5
End DoDot:1
+20 IF ABM("EMRG")="YES"
SET ABM("CNT1")=ABM("CNT1")+.5
+21 IF ABM("EMPL")="YES"
SET ABM("CNT1")=ABM("CNT1")+.5
+22 SET ABM("CNT1")=ABM("CNT1")+.5
+23 SET ABM("CNT1")=$PIECE(ABM("CNT1"),".")
+24 ;
PRV ;
+1 KILL ABM("A"),ABM("O")
+2 SET (ABM("CNT2"),ABM("CNT3"))=1
+3 SET ABM=""
+4 FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),41,"C",ABM))
IF ABM=""
QUIT
SET ABM("X")=$ORDER(^(ABM,""))
SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),41,ABM("X"),0)
IF $PIECE(ABM("X0"),U,2)=""
QUIT
Begin DoDot:1
+5 IF '$DATA(^VA(200,+ABM("X0"),0))
Begin DoDot:2
+6 SET DA(1)=ABMP("CDFN")
+7 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_",41,"
+8 SET DA=ABM("X")
+9 DO ^DIK
End DoDot:2
QUIT
+10 SET ABM($PIECE(ABM("X0"),U,2))=$PIECE(^VA(200,$PIECE(ABM("X0"),U),0),U)
End DoDot:1
+11 SET ABM("OPRV")=$SELECT($DATA(ABM("O")):ABM("O"),1:"")
+12 IF ABM("OPRV")]""
Begin DoDot:1
+13 SET ABM("CNT2")=ABM("CNT2")+1
+14 SET ABM("CNT3")=ABM("CNT3")+1
End DoDot:1
+15 SET ABM("APRV")=$SELECT($DATA(ABM("A")):ABM("A"),1:"")
+16 IF ABM("OPRV")]""
Begin DoDot:1
+17 SET ABM("CNT2")=ABM("CNT2")+1
+18 SET ABM("CNT3")=ABM("CNT3")+1
End DoDot:1
+19 ;
DX ;
+1 IF ABMP("VTYP")=998&'$DATA(ABMP("FLAT"))
GOTO DDS
+2 SET ABM=""
+3 ;F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM)) Q:ABM="" S Y=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,$O(^(ABM,"")),0)),U,3) I Y]"" S ABM("D"_ABM("I"))=$E($G(^AUTNPOV(Y,0)),1,34) ;abm*2.6*14 HEAT161263
+4 ;start new code abm*2.6*14 HEAT161263
+5 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM))
IF ABM=""
QUIT
Begin DoDot:1
+6 SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABM,0))
+7 IF ABMI=""
QUIT
+8 SET IENS=ABMI_","_ABMP("CDFN")_","
+9 SET Y=$$GET1^DIQ(9002274.3017,IENS,".03","E")
+10 IF Y]""
SET ABM("D"_ABM("I"))=$EXTRACT(Y,1,34)
End DoDot:1
+11 ;end new code HEAT161263
+12 SET ABM("CNT2")=ABM("CNT2")+ABM("I")
+13 ;
+14 DO ^ABMDE0X1
+15 QUIT
+16 ;
+17 ; *********************************************************************
DDS ;
+1 SET ABM=0
+2 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+3 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),33,ABM,0),U)
+4 SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($GET(^AUTTADA(Y,0)),U,2),1,34)
End DoDot:1
+5 SET ABM("CNT2")=ABM("CNT2")+ABM("I")
+6 SET ABM=0
+7 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+8 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),35,ABM,0),U)
+9 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+10 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+11 SET ABM=0
+12 FOR ABM("I")=ABM("I"):1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM))
IF 'ABM
QUIT
Begin DoDot:1
+13 SET Y=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),37,ABM,0),U)
+14 ;CSV-c
SET ABM("P"_ABM("I"))=$EXTRACT($PIECE($$CPT^ABMCVAPI(Y,ABMP("VDT")),U,3),1,34)
End DoDot:1
+15 SET ABM("CNT2")=ABM("CNT2")+ABM("I")-1
+16 ;
XIT ;
+1 QUIT
