ABMDEMRG.m

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)