ABMDEMRG ; IHS/ASDST/DMJ - MERGE CLAIMS ;
;;2.6;IHS 3P BILLING SYSTEM;**9,11,19,21**;NOV 12, 2009;Build 379
;
;IHS/DSD/DMJ - 9/14/1999 - NOIS NDA-1198-180003 Patch 3 #14
; By-passed $$NXNM and allowed duplicate claim numbers
;
; IHS/SD/SDR v2.5 p10 - IM20059 - Data was getting overwritten when merging;
; changed so minimal data will be lost
; IHS/SD/SDR - v2.5 p12 - UFMS - If user isn't logged into cashiering session they can't do
; this option; also added so if claims are deleted they will be added to cashiering session
; IHS/SD/SDR - v2.5 p13 - IM26006 - Fix for UNDEF error on page 9D of CE
; IHS/SD/SDR - v2.5 p13 - IM26259 - Fix <UNDEF>DEL+16^ABMDEMRG when capturing deleted claims
; in cashiering session (variable was being overwritten)
;
;IHS/SD/SDR - 2.6*19 - HEAT155799 - If user cancels claim it will now move into the 3P Cancelled Claim file with
; cancellation reason Cancelled due to Merged Claim automatically populated on claim.
;IHS/SD/SDR - 2.6*21 - HEAT242626 - Made it so claims that are already billed can't be merged.
;
START ;START HERE
;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)="" D Q
.W !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
.S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
;end new code
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D Q:+$G(ABMUOPNS)=0
.S ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
.I +$G(ABMUOPNS)=0 D Q
..W !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
..S DIR(0)="E",DIR("A")="Enter RETURN to Continue" D ^DIR K DIR
S DIC="^ABMDCLM(DUZ(2),"
S DIC(0)="AEMQ"
F ABMI=1:1 D Q:$G(ABM("F1"))
.S DIC("A")="Enter "_ABMI_$S(ABMI=1:"st",ABMI=2:"nd",ABMI=3:"rd",1:"th")_" claim: "
.W !
.D ^DIC
.I +Y<0 S ABM("F1")=1 Q
.;start new abm*2.6*21 IHS/SD/SDR HEAT242626
.I ("^F^E^P^"'[("^"_$P($G(^ABMDCLM(DUZ(2),+Y,0)),U,4)_"^")!($D(^ABMDCLM(DUZ(2),+Y,65,0)))) D Q
..W !,"Claim has already been billed or has active bills associated with it"
..W !,"and is therefore unselectable for merging."
..S ABMI=ABMI-1
.;end new abm*2.6*21 IHS/SD/SDR HEAT242626
.I ABMI=1 S ABM("PDFN")=$P(^ABMDCLM(DUZ(2),+Y,0),U),ABM("VTYP")=$P(^(0),"^",7)
.I ABMI=1 S DIC("S")="I $P(^(0),""^"",1)=ABM(""PDFN"")"
.Q:$D(ABM("CLM1",+Y))
.S ABM("CLM1",+Y)=""
.S ABMDL("CLM",ABMI)=+Y
I '$D(ABMDL("CLM")) K ABM Q
K DIC,ABMI
W !,"PATIENT: ",$P($G(^DPT(ABM("PDFN"),0)),U)
W !?3,"CLAIM #s: "
S I=0,ABM("TOT")=0
F S I=$O(ABMDL("CLM",I)) Q:'I D
.W ABMDL("CLM",I)," "
.S ABM("TOT")=ABM("TOT")+1
W !,+$G(ABM("TOT"))," claims selected."
I +$G(ABM("TOT"))<2 K ABM Q
S DIR("A")="Proceed with merge"
S DIR(0)="Y"
D ^DIR
K DIR
I Y'=1 K ABM Q
K DD,DO
S DIC="^ABMDCLM(DUZ(2),"
S DIC(0)="L"
S X=ABM("PDFN")
S DINUM=$$NXNM^ABMDUTL
D FILE^DICN
I +Y<0 W !,"Claim not created.",! K ABM Q
S ABMP("CDFN")=+Y
W !,"Claim # ",ABMP("CDFN")," created.",!
W !,"Merging selected claims to claim ",ABMP("CDFN")
S I=0
F S I=$O(ABMDL("CLM",I)) Q:'I D
.I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U" W !,"Claim # ",ABMDL("CLM",I)," NOT merged-unbillable status." ;don't merge unbillable claims
.;non-multiple nodes
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),0)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),4)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),4)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),5)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),5)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),6)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),6)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),7)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),7)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),8)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),8)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),9)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),9)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),10)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),10)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),12)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),12)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),70)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),70)
.;DINUMed multiples
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),11) ;PCC visits
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),13)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),13) ;Insurers
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),15)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),15) ;APC visits
.I $D(ABMDXTST) D ;flag that coor. dxs need to be removed
..S ABMI=0
..F S ABMI=$O(^ABMDCLM(DUZ(2),ABMDL("CLM",I),17,ABMI)) Q:+ABMI=0 D Q:$G(ABMDXFLG)=1
...I $G(ABMDXTST(ABMI))="" S ABMDXFLG=1
.I $G(ABMDXFLG)'=1 M ABMDXTST=^ABMDCLM(DUZ(2),ABMDL("CLM",I),17)
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),17)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),17) ;DXs
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),19)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),19) ;PXs-DINUMed in routine ABMDE5D
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),51)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),51) ;Occurrence Codes
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),53)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),53) ;Condition Codes
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),59)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),59) ;Special Program codes
.;not DINUMED multiples
.F ABMMULT=14,21,23,25,27,33,35,37,39,41,43,45,47,57,61 D MULT ;merge multiples into array
.;weird DINUMed multiples
.S ABMI=0
.M ABMDCLM(55,0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,0)
.F S ABMI=$O(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI)) Q:+ABMI=0 D
..I $G(ABMDCLM(55,ABMI,0))'="",($P($G(^ABMDCODE($P($G(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0)),U),0)),U,2)="V") S $P(ABMDCLM(55,ABMI,0),U,2)=$P(ABMDCLM(55,ABMI,0),U,2)+$P($G(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0)),U,2)
..E S ABMDCLM(55,ABMI,0)=$G(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0))
.S ABM("SDF")=$P(^ABMDCLM(DUZ(2),ABMDL("CLM",I),7),U)
.S ABM("SDT")=$P(^ABMDCLM(DUZ(2),ABMDL("CLM",I),7),U,2)
.D
..I I=1 D Q
...S ABM("OSDF")=ABM("SDF")
...S ABM("OSDT")=ABM("SDT")
...Q
..I ABM("SDF")<ABM("OSDF"),ABM("SDF")'="" S ABM("OSDF")=ABM("SDF")
..I ABM("SDT")>ABM("OSDT") S ABM("OSDT")=ABM("SDT")
.W !,"Claim # ",ABMDL("CLM",I)," merged."
;
I ABM("OSDF")<$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U) D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".71///"_ABM("OSDF")
.D ^DIE
.Q
I ABM("OSDT")>$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),"^",2) D
.S DIE="^ABMDCLM(DUZ(2),"
.S DA=ABMP("CDFN")
.S DR=".72///"_ABM("OSDT")
.D ^DIE
.Q
;
;each med necess. indicator only once on claim
I $D(ABMDCLM(14)) D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(14,ABMIEN)) Q:+ABMIEN=0 D
..I $G(ABMMED($G(ABMDCLM(14,ABMIEN,0))))'="" K ABMDCLM(14,ABMIEN,0)
..E S ABMMED($G(ABMDCLM(14,ABMIEN,0)))=1
;make sure only one attending provider
I $D(ABMDCLM(41)) D
.S ABMIEN=999 ;start at last entry and go up; want attending from last claim selected
.F S ABMIEN=$O(ABMDCLM(41,ABMIEN),-1) Q:+ABMIEN=0 D
..I $P($G(ABMDCLM(41,ABMIEN,0)),U,2)="A",($G(ABMPRV("A"))'="") S $P(ABMDCLM(41,ABMIEN,0),U,2)="T"
..I $G(ABMPRV("A"))="" S ABMPRV("A")=ABMIEN
;
;merge line items into new claim
S ABMMULT=""
F S ABMMULT=$O(ABMDCLM(ABMMULT)) Q:$G(ABMMULT)="" D
.S ABMIEN=0
.M ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMMULT,0)=ABMDCLM(ABMMULT,0)
.F S ABMIEN=$O(ABMDCLM(ABMMULT,ABMIEN)) Q:+ABMIEN=0 D
..M ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMMULT,ABMIEN)=ABMDCLM(ABMMULT,ABMIEN)
;
;check/remove coordinating Dxs because they will no longer be accurate
I $G(ABMDXFLG)=1 D
.W !!,"More than 1 DX exists on merging claims. All Current Coordinating"
.W !,"DX pointers being removed"
.F ABMI=21,23,27,33,35,37,39,43,45,47 D
..S ABMIEN=0
..F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMIEN)) Q:+ABMIEN=0 D
...K DIC,DIE,DA,DR,X,Y
...S DA(1)=ABMP("CDFN")
...S DA=ABMIEN
...S DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMI_","
...I ABMI=21 S DR=".04////@"
...I ABMI=23 S DR=".13////@"
...I ABMI=27 S DR=".06////@"
...I ABMI=33 S DR=".04////@"
...I ABMI=35 S DR=".08////@"
...I ABMI=37 S DR=".09////@"
...I ABMI=39 S DR=".1////@"
...I ABMI=43 S DR=".06////@"
...I ABMI=45 S DR=".06////@"
...I ABMI=47 S DR=".06////@"
...D ^DIE
;
PRIO ;re-shuffle priority fields for new claim
F I=13,17,19,21,41 D ; Add node 41 to have Xref's killed/rebuilt
.Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),I))
.S J=0,L=0
.F S J=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C",J)) Q:'J D
..S K=0
..F S K=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C",J,K)) Q:'K D
...Q:$D(ABM("PRIO",K))
...S ABM("PRIO",K)=""
...S L=L+1
...S $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",2)=L
...I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",3)="I" D
....Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",8)=K
....S $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",3)="P"
....Q
.K ^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"B")
.K ^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C")
.S DA(1)=ABMP("CDFN")
.S DIK="^ABMDCLM(DUZ(2),DA(1),I,"
.D IXALL^DIK
W !!,"Cross referencing new claim # ",ABMP("CDFN"),!
S DIK="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D IX1^DIK
I $D(ABMDCLM(21))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(21,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(21,ABMIEN,0)),U,3)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",21,"
..S DR=".03////"_$P(ABMDCLM(21,ABMIEN,0),U,3)
..D ^DIE
I $D(ABMDCLM(23))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(23,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(23,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",23,"
..S DR=".02////"_$P(ABMDCLM(23,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(27))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(27,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(27,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",27,"
..S DR=".02////"_$P(ABMDCLM(27,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(33))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(33,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(33,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",33,"
..S DR=".02////"_$P(ABMDCLM(33,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(35))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(35,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(35,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",35,"
..S DR=".02////"_$P(ABMDCLM(35,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(37))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(37,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(37,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",37,"
..S DR=".02////"_$P(ABMDCLM(37,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(39))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(39,ABMIEN)) Q:+ABMIEN=0 D
..I $P($G(ABMDCLM(39,ABMIEN,0)),U,3)'="" D
...K DIE,DA,DR,DIC,DIR,X,Y
...S DA(1)=ABMP("CDFN")
...S DA=ABMIEN
...S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",39,"
...S DR=".03////"_$P(ABMDCLM(39,ABMIEN,0),U,3)
...D ^DIE
..I $P($G(ABMDCLM(39,ABMIEN,0)),U,2)'="" D
...K DIE,DA,DR,DIC,DIR,X,Y
...S DA(1)=ABMP("CDFN")
...S DA=ABMIEN
...S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",39,"
...S DR=".02////"_$P(ABMDCLM(39,ABMIEN,0),U,2)
...D ^DIE
I $D(ABMDCLM(43))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(43,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(43,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",43,"
..S DR=".02////"_$P(ABMDCLM(43,ABMIEN,0),U,2)
..D ^DIE
I $D(ABMDCLM(47))=10 D
.S ABMIEN=0
.F S ABMIEN=$O(ABMDCLM(47,ABMIEN)) Q:+ABMIEN=0 D
..Q:$P($G(ABMDCLM(47,ABMIEN,0)),U,2)=""
..K DIE,DA,DR,DIC,DIR,X,Y
..S DA(1)=ABMP("CDFN")
..S DA=ABMIEN
..S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",47,"
..S DR=".02////"_$P(ABMDCLM(47,ABMIEN,0),U,2)
..D ^DIE
K ABMDCLM,ABMPRV,ABMMED,ABMDXTST
;
CLM ;go to claim editor
S DIR("A")="Proceed to Claim Editor"
S DIR(0)="Y"
S DIR("B")="N"
D ^DIR
K DIR
I Y=1 S ABMPP("CLM")="" D EXT^ABMDE
;
DEL ;delete the claims merged from
S DIR("A")="Delete claims merged from"
S DIR(0)="Y"
S DIR("B")="N"
D ^DIR
K DIR
I Y=1 D
.;S DIK="^ABMDCLM(DUZ(2)," ;abm*2.6*11 NOHEAT5
.S ABMCLMI=0
.F S ABMCLMI=$O(ABMDL("CLM",ABMCLMI)) Q:'ABMCLMI D
..;start old abm*2.6*19 IHS/SD/SDR HEAT155799
..;K DA,DIC,DIE,DR
..;D ADDBENTR^ABMUCUTL("CCLM",ABMDL("CLM",ABMCLMI)) ;add claim to UFMS Cash. Session
..;S DIK="^ABMDCLM(DUZ(2)," ;abm*2.6*11 NOHEAT5
..;S DA=ABMDL("CLM",ABMCLMI)
..;D ^DIK
..;W !,"Claim # ",DA,$S($D(^ABMDCLM(DUZ(2),DA)):" NOT",1:"")," deleted."
..;end old start new abm*2.6*19 IHS/SD/SDR HEAT155799
..S ABMP("CDFN")=ABMDL("CLM",ABMCLMI)
..S ABMREAS="CANCELLED DUE TO MERGED CLAIM"
..D ENT3^ABMDECAN
..;end new abm*2.6*19 IHS/SD/SDR HEAT155799
W !
K ABM
Q
MULT ;merge multiples into array by subfile to be stored on "master" claim when all are merged
I $G(ABM(ABMMULT))="" S ABM(ABMMULT)=1
S ABMIEN=0
M ABMDCLM(ABMMULT,0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,0)
F S ABMIEN=$O(^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,ABMIEN)) Q:+ABMIEN=0 D
.M ABMDCLM(ABMMULT,ABM(ABMMULT))=^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,ABMIEN)
.S ABM(ABMMULT)=$G(ABM(ABMMULT))+1
Q
ABMDEMRG ; IHS/ASDST/DMJ - MERGE CLAIMS ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**9,11,19,21**;NOV 12, 2009;Build 379
+2 ;
+3 ;IHS/DSD/DMJ - 9/14/1999 - NOIS NDA-1198-180003 Patch 3 #14
+4 ; By-passed $$NXNM and allowed duplicate claim numbers
+5 ;
+6 ; IHS/SD/SDR v2.5 p10 - IM20059 - Data was getting overwritten when merging;
+7 ; changed so minimal data will be lost
+8 ; IHS/SD/SDR - v2.5 p12 - UFMS - If user isn't logged into cashiering session they can't do
+9 ; this option; also added so if claims are deleted they will be added to cashiering session
+10 ; IHS/SD/SDR - v2.5 p13 - IM26006 - Fix for UNDEF error on page 9D of CE
+11 ; IHS/SD/SDR - v2.5 p13 - IM26259 - Fix <UNDEF>DEL+16^ABMDEMRG when capturing deleted claims
+12 ; in cashiering session (variable was being overwritten)
+13 ;
+14 ;IHS/SD/SDR - 2.6*19 - HEAT155799 - If user cancels claim it will now move into the 3P Cancelled Claim file with
+15 ; cancellation reason Cancelled due to Merged Claim automatically populated on claim.
+16 ;IHS/SD/SDR - 2.6*21 - HEAT242626 - Made it so claims that are already billed can't be merged.
+17 ;
START ;START HERE
+1 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+2 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+3 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+4 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+5 ;end new code
+6 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+7 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+8 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+9 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+10 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:2
QUIT
End DoDot:1
IF +$GET(ABMUOPNS)=0
QUIT
+11 SET DIC="^ABMDCLM(DUZ(2),"
+12 SET DIC(0)="AEMQ"
+13 FOR ABMI=1:1
Begin DoDot:1
+14 SET DIC("A")="Enter "_ABMI_$SELECT(ABMI=1:"st",ABMI=2:"nd",ABMI=3:"rd",1:"th")_" claim: "
+15 WRITE !
+16 DO ^DIC
+17 IF +Y<0
SET ABM("F1")=1
QUIT
+18 ;start new abm*2.6*21 IHS/SD/SDR HEAT242626
+19 IF ("^F^E^P^"'[("^"_$PIECE($GET(^ABMDCLM(DUZ(2),+Y,0)),U,4)_"^")!($DATA(^ABMDCLM(DUZ(2),+Y,65,0))))
Begin DoDot:2
+20 WRITE !,"Claim has already been billed or has active bills associated with it"
+21 WRITE !,"and is therefore unselectable for merging."
+22 SET ABMI=ABMI-1
End DoDot:2
QUIT
+23 ;end new abm*2.6*21 IHS/SD/SDR HEAT242626
+24 IF ABMI=1
SET ABM("PDFN")=$PIECE(^ABMDCLM(DUZ(2),+Y,0),U)
SET ABM("VTYP")=$PIECE(^(0),"^",7)
+25 IF ABMI=1
SET DIC("S")="I $P(^(0),""^"",1)=ABM(""PDFN"")"
+26 IF $DATA(ABM("CLM1",+Y))
QUIT
+27 SET ABM("CLM1",+Y)=""
+28 SET ABMDL("CLM",ABMI)=+Y
End DoDot:1
IF $GET(ABM("F1"))
QUIT
+29 IF '$DATA(ABMDL("CLM"))
KILL ABM
QUIT
+30 KILL DIC,ABMI
+31 WRITE !,"PATIENT: ",$PIECE($GET(^DPT(ABM("PDFN"),0)),U)
+32 WRITE !?3,"CLAIM #s: "
+33 SET I=0
SET ABM("TOT")=0
+34 FOR
SET I=$ORDER(ABMDL("CLM",I))
IF 'I
QUIT
Begin DoDot:1
+35 WRITE ABMDL("CLM",I)," "
+36 SET ABM("TOT")=ABM("TOT")+1
End DoDot:1
+37 WRITE !,+$GET(ABM("TOT"))," claims selected."
+38 IF +$GET(ABM("TOT"))<2
KILL ABM
QUIT
+39 SET DIR("A")="Proceed with merge"
+40 SET DIR(0)="Y"
+41 DO ^DIR
+42 KILL DIR
+43 IF Y'=1
KILL ABM
QUIT
+44 KILL DD,DO
+45 SET DIC="^ABMDCLM(DUZ(2),"
+46 SET DIC(0)="L"
+47 SET X=ABM("PDFN")
+48 SET DINUM=$$NXNM^ABMDUTL
+49 DO FILE^DICN
+50 IF +Y<0
WRITE !,"Claim not created.",!
KILL ABM
QUIT
+51 SET ABMP("CDFN")=+Y
+52 WRITE !,"Claim # ",ABMP("CDFN")," created.",!
+53 WRITE !,"Merging selected claims to claim ",ABMP("CDFN")
+54 SET I=0
+55 FOR
SET I=$ORDER(ABMDL("CLM",I))
IF 'I
QUIT
Begin DoDot:1
+56 ;don't merge unbillable claims
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)="U"
WRITE !,"Claim # ",ABMDL("CLM",I)," NOT merged-unbillable status."
+57 ;non-multiple nodes
+58 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),0)
+59 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),4)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),4)
+60 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),5)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),5)
+61 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),6)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),6)
+62 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),7)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),7)
+63 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),8)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),8)
+64 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),9)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),9)
+65 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),10)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),10)
+66 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),12)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),12)
+67 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),70)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),70)
+68 ;DINUMed multiples
+69 ;PCC visits
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),11)
+70 ;Insurers
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),13)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),13)
+71 ;APC visits
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),15)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),15)
+72 ;flag that coor. dxs need to be removed
IF $DATA(ABMDXTST)
Begin DoDot:2
+73 SET ABMI=0
+74 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMDL("CLM",I),17,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:3
+75 IF $GET(ABMDXTST(ABMI))=""
SET ABMDXFLG=1
End DoDot:3
IF $GET(ABMDXFLG)=1
QUIT
End DoDot:2
+76 IF $GET(ABMDXFLG)'=1
MERGE ABMDXTST=^ABMDCLM(DUZ(2),ABMDL("CLM",I),17)
+77 ;DXs
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),17)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),17)
+78 ;PXs-DINUMed in routine ABMDE5D
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),19)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),19)
+79 ;Occurrence Codes
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),51)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),51)
+80 ;Condition Codes
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),53)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),53)
+81 ;Special Program codes
MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),59)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),59)
+82 ;not DINUMED multiples
+83 ;merge multiples into array
FOR ABMMULT=14,21,23,25,27,33,35,37,39,41,43,45,47,57,61
DO MULT
+84 ;weird DINUMed multiples
+85 SET ABMI=0
+86 MERGE ABMDCLM(55,0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,0)
+87 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI))
IF +ABMI=0
QUIT
Begin DoDot:2
+88 IF $GET(ABMDCLM(55,ABMI,0))'=""
IF ($PIECE($GET(^ABMDCODE($PIECE($GET(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0)),U),0)),U,2)="V")
SET $PIECE(ABMDCLM(55,ABMI,0),U,2)=$PIECE(ABMDCLM(55,ABMI,0),U,2)+$PIECE($GET(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0)),U,2)
+89 IF '$TEST
SET ABMDCLM(55,ABMI,0)=$GET(^ABMDCLM(DUZ(2),ABMDL("CLM",I),55,ABMI,0))
End DoDot:2
+90 SET ABM("SDF")=$PIECE(^ABMDCLM(DUZ(2),ABMDL("CLM",I),7),U)
+91 SET ABM("SDT")=$PIECE(^ABMDCLM(DUZ(2),ABMDL("CLM",I),7),U,2)
+92 Begin DoDot:2
+93 IF I=1
Begin DoDot:3
+94 SET ABM("OSDF")=ABM("SDF")
+95 SET ABM("OSDT")=ABM("SDT")
+96 QUIT
End DoDot:3
QUIT
+97 IF ABM("SDF")<ABM("OSDF")
IF ABM("SDF")'=""
SET ABM("OSDF")=ABM("SDF")
+98 IF ABM("SDT")>ABM("OSDT")
SET ABM("OSDT")=ABM("SDT")
End DoDot:2
+99 WRITE !,"Claim # ",ABMDL("CLM",I)," merged."
End DoDot:1
+100 ;
+101 IF ABM("OSDF")<$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),U)
Begin DoDot:1
+102 SET DIE="^ABMDCLM(DUZ(2),"
+103 SET DA=ABMP("CDFN")
+104 SET DR=".71///"_ABM("OSDF")
+105 DO ^DIE
+106 QUIT
End DoDot:1
+107 IF ABM("OSDT")>$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),7),"^",2)
Begin DoDot:1
+108 SET DIE="^ABMDCLM(DUZ(2),"
+109 SET DA=ABMP("CDFN")
+110 SET DR=".72///"_ABM("OSDT")
+111 DO ^DIE
+112 QUIT
End DoDot:1
+113 ;
+114 ;each med necess. indicator only once on claim
+115 IF $DATA(ABMDCLM(14))
Begin DoDot:1
+116 SET ABMIEN=0
+117 FOR
SET ABMIEN=$ORDER(ABMDCLM(14,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+118 IF $GET(ABMMED($GET(ABMDCLM(14,ABMIEN,0))))'=""
KILL ABMDCLM(14,ABMIEN,0)
+119 IF '$TEST
SET ABMMED($GET(ABMDCLM(14,ABMIEN,0)))=1
End DoDot:2
End DoDot:1
+120 ;make sure only one attending provider
+121 IF $DATA(ABMDCLM(41))
Begin DoDot:1
+122 ;start at last entry and go up; want attending from last claim selected
SET ABMIEN=999
+123 FOR
SET ABMIEN=$ORDER(ABMDCLM(41,ABMIEN),-1)
IF +ABMIEN=0
QUIT
Begin DoDot:2
+124 IF $PIECE($GET(ABMDCLM(41,ABMIEN,0)),U,2)="A"
IF ($GET(ABMPRV("A"))'="")
SET $PIECE(ABMDCLM(41,ABMIEN,0),U,2)="T"
+125 IF $GET(ABMPRV("A"))=""
SET ABMPRV("A")=ABMIEN
End DoDot:2
End DoDot:1
+126 ;
+127 ;merge line items into new claim
+128 SET ABMMULT=""
+129 FOR
SET ABMMULT=$ORDER(ABMDCLM(ABMMULT))
IF $GET(ABMMULT)=""
QUIT
Begin DoDot:1
+130 SET ABMIEN=0
+131 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMMULT,0)=ABMDCLM(ABMMULT,0)
+132 FOR
SET ABMIEN=$ORDER(ABMDCLM(ABMMULT,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+133 MERGE ^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMMULT,ABMIEN)=ABMDCLM(ABMMULT,ABMIEN)
End DoDot:2
End DoDot:1
+134 ;
+135 ;check/remove coordinating Dxs because they will no longer be accurate
+136 IF $GET(ABMDXFLG)=1
Begin DoDot:1
+137 WRITE !!,"More than 1 DX exists on merging claims. All Current Coordinating"
+138 WRITE !,"DX pointers being removed"
+139 FOR ABMI=21,23,27,33,35,37,39,43,45,47
Begin DoDot:2
+140 SET ABMIEN=0
+141 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMI,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:3
+142 KILL DIC,DIE,DA,DR,X,Y
+143 SET DA(1)=ABMP("CDFN")
+144 SET DA=ABMIEN
+145 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMI_","
+146 IF ABMI=21
SET DR=".04////@"
+147 IF ABMI=23
SET DR=".13////@"
+148 IF ABMI=27
SET DR=".06////@"
+149 IF ABMI=33
SET DR=".04////@"
+150 IF ABMI=35
SET DR=".08////@"
+151 IF ABMI=37
SET DR=".09////@"
+152 IF ABMI=39
SET DR=".1////@"
+153 IF ABMI=43
SET DR=".06////@"
+154 IF ABMI=45
SET DR=".06////@"
+155 IF ABMI=47
SET DR=".06////@"
+156 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+157 ;
PRIO ;re-shuffle priority fields for new claim
+1 ; Add node 41 to have Xref's killed/rebuilt
FOR I=13,17,19,21,41
Begin DoDot:1
+2 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),I))
QUIT
+3 SET J=0
SET L=0
+4 FOR
SET J=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C",J))
IF 'J
QUIT
Begin DoDot:2
+5 SET K=0
+6 FOR
SET K=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C",J,K))
IF 'K
QUIT
Begin DoDot:3
+7 IF $DATA(ABM("PRIO",K))
QUIT
+8 SET ABM("PRIO",K)=""
+9 SET L=L+1
+10 SET $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",2)=L
+11 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",3)="I"
Begin DoDot:4
+12 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",8)=K
QUIT
+13 SET $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),I,K,0),"^",3)="P"
+14 QUIT
End DoDot:4
End DoDot:3
End DoDot:2
+15 KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"B")
+16 KILL ^ABMDCLM(DUZ(2),ABMP("CDFN"),I,"C")
+17 SET DA(1)=ABMP("CDFN")
+18 SET DIK="^ABMDCLM(DUZ(2),DA(1),I,"
+19 DO IXALL^DIK
End DoDot:1
+20 WRITE !!,"Cross referencing new claim # ",ABMP("CDFN"),!
+21 SET DIK="^ABMDCLM(DUZ(2),"
+22 SET DA=ABMP("CDFN")
+23 DO IX1^DIK
+24 IF $DATA(ABMDCLM(21))=10
Begin DoDot:1
+25 SET ABMIEN=0
+26 FOR
SET ABMIEN=$ORDER(ABMDCLM(21,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+27 IF $PIECE($GET(ABMDCLM(21,ABMIEN,0)),U,3)=""
QUIT
+28 KILL DIE,DA,DR,DIC,DIR,X,Y
+29 SET DA(1)=ABMP("CDFN")
+30 SET DA=ABMIEN
+31 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",21,"
+32 SET DR=".03////"_$PIECE(ABMDCLM(21,ABMIEN,0),U,3)
+33 DO ^DIE
End DoDot:2
End DoDot:1
+34 IF $DATA(ABMDCLM(23))=10
Begin DoDot:1
+35 SET ABMIEN=0
+36 FOR
SET ABMIEN=$ORDER(ABMDCLM(23,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+37 IF $PIECE($GET(ABMDCLM(23,ABMIEN,0)),U,2)=""
QUIT
+38 KILL DIE,DA,DR,DIC,DIR,X,Y
+39 SET DA(1)=ABMP("CDFN")
+40 SET DA=ABMIEN
+41 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",23,"
+42 SET DR=".02////"_$PIECE(ABMDCLM(23,ABMIEN,0),U,2)
+43 DO ^DIE
End DoDot:2
End DoDot:1
+44 IF $DATA(ABMDCLM(27))=10
Begin DoDot:1
+45 SET ABMIEN=0
+46 FOR
SET ABMIEN=$ORDER(ABMDCLM(27,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+47 IF $PIECE($GET(ABMDCLM(27,ABMIEN,0)),U,2)=""
QUIT
+48 KILL DIE,DA,DR,DIC,DIR,X,Y
+49 SET DA(1)=ABMP("CDFN")
+50 SET DA=ABMIEN
+51 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",27,"
+52 SET DR=".02////"_$PIECE(ABMDCLM(27,ABMIEN,0),U,2)
+53 DO ^DIE
End DoDot:2
End DoDot:1
+54 IF $DATA(ABMDCLM(33))=10
Begin DoDot:1
+55 SET ABMIEN=0
+56 FOR
SET ABMIEN=$ORDER(ABMDCLM(33,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+57 IF $PIECE($GET(ABMDCLM(33,ABMIEN,0)),U,2)=""
QUIT
+58 KILL DIE,DA,DR,DIC,DIR,X,Y
+59 SET DA(1)=ABMP("CDFN")
+60 SET DA=ABMIEN
+61 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",33,"
+62 SET DR=".02////"_$PIECE(ABMDCLM(33,ABMIEN,0),U,2)
+63 DO ^DIE
End DoDot:2
End DoDot:1
+64 IF $DATA(ABMDCLM(35))=10
Begin DoDot:1
+65 SET ABMIEN=0
+66 FOR
SET ABMIEN=$ORDER(ABMDCLM(35,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+67 IF $PIECE($GET(ABMDCLM(35,ABMIEN,0)),U,2)=""
QUIT
+68 KILL DIE,DA,DR,DIC,DIR,X,Y
+69 SET DA(1)=ABMP("CDFN")
+70 SET DA=ABMIEN
+71 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",35,"
+72 SET DR=".02////"_$PIECE(ABMDCLM(35,ABMIEN,0),U,2)
+73 DO ^DIE
End DoDot:2
End DoDot:1
+74 IF $DATA(ABMDCLM(37))=10
Begin DoDot:1
+75 SET ABMIEN=0
+76 FOR
SET ABMIEN=$ORDER(ABMDCLM(37,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+77 IF $PIECE($GET(ABMDCLM(37,ABMIEN,0)),U,2)=""
QUIT
+78 KILL DIE,DA,DR,DIC,DIR,X,Y
+79 SET DA(1)=ABMP("CDFN")
+80 SET DA=ABMIEN
+81 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",37,"
+82 SET DR=".02////"_$PIECE(ABMDCLM(37,ABMIEN,0),U,2)
+83 DO ^DIE
End DoDot:2
End DoDot:1
+84 IF $DATA(ABMDCLM(39))=10
Begin DoDot:1
+85 SET ABMIEN=0
+86 FOR
SET ABMIEN=$ORDER(ABMDCLM(39,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+87 IF $PIECE($GET(ABMDCLM(39,ABMIEN,0)),U,3)'=""
Begin DoDot:3
+88 KILL DIE,DA,DR,DIC,DIR,X,Y
+89 SET DA(1)=ABMP("CDFN")
+90 SET DA=ABMIEN
+91 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",39,"
+92 SET DR=".03////"_$PIECE(ABMDCLM(39,ABMIEN,0),U,3)
+93 DO ^DIE
End DoDot:3
+94 IF $PIECE($GET(ABMDCLM(39,ABMIEN,0)),U,2)'=""
Begin DoDot:3
+95 KILL DIE,DA,DR,DIC,DIR,X,Y
+96 SET DA(1)=ABMP("CDFN")
+97 SET DA=ABMIEN
+98 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",39,"
+99 SET DR=".02////"_$PIECE(ABMDCLM(39,ABMIEN,0),U,2)
+100 DO ^DIE
End DoDot:3
End DoDot:2
End DoDot:1
+101 IF $DATA(ABMDCLM(43))=10
Begin DoDot:1
+102 SET ABMIEN=0
+103 FOR
SET ABMIEN=$ORDER(ABMDCLM(43,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+104 IF $PIECE($GET(ABMDCLM(43,ABMIEN,0)),U,2)=""
QUIT
+105 KILL DIE,DA,DR,DIC,DIR,X,Y
+106 SET DA(1)=ABMP("CDFN")
+107 SET DA=ABMIEN
+108 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",43,"
+109 SET DR=".02////"_$PIECE(ABMDCLM(43,ABMIEN,0),U,2)
+110 DO ^DIE
End DoDot:2
End DoDot:1
+111 IF $DATA(ABMDCLM(47))=10
Begin DoDot:1
+112 SET ABMIEN=0
+113 FOR
SET ABMIEN=$ORDER(ABMDCLM(47,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:2
+114 IF $PIECE($GET(ABMDCLM(47,ABMIEN,0)),U,2)=""
QUIT
+115 KILL DIE,DA,DR,DIC,DIR,X,Y
+116 SET DA(1)=ABMP("CDFN")
+117 SET DA=ABMIEN
+118 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",47,"
+119 SET DR=".02////"_$PIECE(ABMDCLM(47,ABMIEN,0),U,2)
+120 DO ^DIE
End DoDot:2
End DoDot:1
+121 KILL ABMDCLM,ABMPRV,ABMMED,ABMDXTST
+122 ;
CLM ;go to claim editor
+1 SET DIR("A")="Proceed to Claim Editor"
+2 SET DIR(0)="Y"
+3 SET DIR("B")="N"
+4 DO ^DIR
+5 KILL DIR
+6 IF Y=1
SET ABMPP("CLM")=""
DO EXT^ABMDE
+7 ;
DEL ;delete the claims merged from
+1 SET DIR("A")="Delete claims merged from"
+2 SET DIR(0)="Y"
+3 SET DIR("B")="N"
+4 DO ^DIR
+5 KILL DIR
+6 IF Y=1
Begin DoDot:1
+7 ;S DIK="^ABMDCLM(DUZ(2)," ;abm*2.6*11 NOHEAT5
+8 SET ABMCLMI=0
+9 FOR
SET ABMCLMI=$ORDER(ABMDL("CLM",ABMCLMI))
IF 'ABMCLMI
QUIT
Begin DoDot:2
+10 ;start old abm*2.6*19 IHS/SD/SDR HEAT155799
+11 ;K DA,DIC,DIE,DR
+12 ;D ADDBENTR^ABMUCUTL("CCLM",ABMDL("CLM",ABMCLMI)) ;add claim to UFMS Cash. Session
+13 ;S DIK="^ABMDCLM(DUZ(2)," ;abm*2.6*11 NOHEAT5
+14 ;S DA=ABMDL("CLM",ABMCLMI)
+15 ;D ^DIK
+16 ;W !,"Claim # ",DA,$S($D(^ABMDCLM(DUZ(2),DA)):" NOT",1:"")," deleted."
+17 ;end old start new abm*2.6*19 IHS/SD/SDR HEAT155799
+18 SET ABMP("CDFN")=ABMDL("CLM",ABMCLMI)
+19 SET ABMREAS="CANCELLED DUE TO MERGED CLAIM"
+20 DO ENT3^ABMDECAN
+21 ;end new abm*2.6*19 IHS/SD/SDR HEAT155799
End DoDot:2
End DoDot:1
+22 WRITE !
+23 KILL ABM
+24 QUIT
MULT ;merge multiples into array by subfile to be stored on "master" claim when all are merged
+1 IF $GET(ABM(ABMMULT))=""
SET ABM(ABMMULT)=1
+2 SET ABMIEN=0
+3 MERGE ABMDCLM(ABMMULT,0)=^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,0)
+4 FOR
SET ABMIEN=$ORDER(^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,ABMIEN))
IF +ABMIEN=0
QUIT
Begin DoDot:1
+5 MERGE ABMDCLM(ABMMULT,ABM(ABMMULT))=^ABMDCLM(DUZ(2),ABMDL("CLM",I),ABMMULT,ABMIEN)
+6 SET ABM(ABMMULT)=$GET(ABM(ABMMULT))+1
End DoDot:1
+7 QUIT
