ABMDECAN ; IHS/ASDST/DMJ - Cancel Selected Claim ;
;;2.6;IHS 3P BILLING SYSTEM;**9,11,19,21**;NOV 12, 2009;Build 379
;
; 03/10/04 V2.5 Patch 5 - Deny cancel claim if bill attached
; IHS/SD/SDR - V2.5 P8 - Added code for cancellation reason
; IHS/SD/SDR - v2.5 p10 - IM20454 - Fix cancellation when replacement insurer present
; IHS/SD/SDR - v2.5 p12 - UFMS - If user isn't logged into cashiering session they can't do
; this option. Also added call to populate cashiering session with claim/bill number if they
; are cancelling. Also added who cancelled bill, when, and reason (.111,.112,.113)
;
;IHS/SD/SDR - 2.6*19 - HEAT155799 - Updated code that creates 3P Cancelled Claim entry so it can
; be called from the Merged claim option if user decides to delete claims that were merged.
;IHS/SD/SDR - 2.6*21 - HEAT242626 - Updated so only claims with a status of F, E or P can be cancelled.
;
K ABMP
S U="^"
S ABMP("XMIT")=0
;
SEL ;
W !!
D ^ABMDEDIC
G XIT:X=""!$D(DUOUT)!$D(DTOUT)!'+$G(ABMP("CDFN"))
I +Y<1 G SEL
;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
;start new abm*2.6*21 IHS/SD/SDR HEAT242626
I "^F^E^P^"'[("^"_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_"^") D G SEL
.W !,*7,"Claim status is ("_$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_") "_$P($P($P(^DD(9002274.3,.04,0),U,3),$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_":",2),";")
.W !,"Only claims with one of the below status can be cancelled:"
.W !?3,"(F) Flagged as Billable"
.W !?3,"(E) In Edit Mode"
.W !?3,"(P) Pending"
;end new abm*2.6*21 IHS/SD/SDR HEAT242626
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),65)) D G:ABMACBEX SEL
.S ABMACBEX=0
.S D1=0
.F S D1=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1)) Q:'D1 D
..I +^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1,0) S ABMACBEX=1
.I $G(ABMACBEX) D
..W !,*7,"An active bill exists for this claim. Cancelling of claim not allowed!"
.K D1
K ABMACBEX
L +^ABMDCLM(DUZ(2),ABMP("CDFN")):0 I '$T W !?5,*7,"Another User is Editing this Record!" G SEL
D ENT
G XIT:$D(DUOUT)!$D(DTOUT),SEL
;
XIT ;
L -^ABMDCLM(DUZ(2))
K ABMP
F W ! Q:$Y+3>IOSL
S DIR(0)="E" D ^DIR K DIR
Q
;
ENT ;EP - to Cancel a Claim
I '$D(^XUSEC("ABMDZ CANCEL CLAIM",DUZ)) W !!,"You don't have enough access to cancel claims",! Q
W !,*7,"WARNING: If you cancel this Claim it will be deleted and no further Editing",!?9,"or Approvals can occur.",!
;
ENT2 ;EP - BYPASS THE WARNING
S DIR(0)="Y"
S DIR("A")="Do you wish Claim Number "_ABMP("CDFN")_" DELETED (Y/N)"
D ^DIR
I Y'=1 Q
W !
;abm*2.6*19 IHS/SD/SDR HEAT155799 - added line tag ENT3
ENT3 ;EP - Delete claim without asking
S DIE="^ABMCCLMS(DUZ(2),"
S DA=ABMP("CDFN")
S DIE("NO^")="OUTOK"
;S DR=".04////X;.114////"_DUZ_";.115///NOW;.118R~Cancellation REASON:" ;abm*2.6*19 IHS/SD/SDR HEAT155799
I $G(ABMREAS)'="" S DR=".04////X;.114////"_DUZ_";.115///NOW;.118///"_ABMREAS ;abm*2.6*19 IHS/SD/SDR HEAT155799
I $G(ABMREAS)="" S DR=".04////X;.114////"_DUZ_";.115///NOW;.118R~Cancellation REASON:" ;abm*2.6*19 IHS/SD/SDR HEAT155799
D ^DIE
I $P($G(^ABMCCLMS(DUZ(2),ABMP("CDFN"),1)),U,8)="" D Q
.;W !!,"CLAIM NOT CANCELLED" ;abm*2.6*19 IHS/SD/SDR HEAT155799
.W !!,"CLAIM "_ABMP("CDFN")_" NOT CANCELLED" ;abm*2.6*19 IHS/SD/SDR HEAT155799
.S DIK="^ABMCCLMS(DUZ(2),"
.S DA=ABMP("CDFN")
.D ^DIK
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMP("CDFN"),11) ;PCC Visits
M ^ABMCCLMS(DUZ(2),ABMP("CDFN"),41)=^ABMDCLM(DUZ(2),ABMP("CDFN"),41) ;Providers
S DIK="^ABMCCLMS(DUZ(2),"
S DA=ABMP("CDFN")
D IX^DIK ;merged entries don't x-ref
W !!,"OK, the claim is being deleted..."
S DR=".04///1" D KCLM
W !!,"Claim Number: ",ABMP("CDFN")," has been Deleted!"
S ^ABMDTMP("KCLM",DT,ABMP("CDFN"))=DUZ
Q
;
KCLM ;EP for Deleting Claim
S DIE="^AUPNVSIT("
S DA=0 F S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,DA)) Q:'DA D
.Q:$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),""))]""
.Q:'$D(^AUPNVSIT(DA,0))
.D ^ABMDDIE
S DA=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0))
I DA D
.Q:$O(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),""))]""
.Q:'$D(^AAPCRCDS(DA,0))
.S ^AAPCRCDS("ACAN",DA)=ABMP("CDFN")
I $P($G(^ABMDPARM(DUZ(2),1,4)),U,15)=1 D ADDBENTR^ABMUCUTL("CCLM",ABMP("CDFN")) ;add clm to UFMS Cash. Session
S DIK="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D ^ABMDEDIK
Q
;
BILL ;EP - to cancel a Bill
W !
K ABMP
S U="^"
S ABMP("XMIT")=0
;
BSEL ;
; Ask the user which bill to cancel
K DIC
S DIC="^ABMDBILL(DUZ(2),"
S DIC(0)="QEAM"
S DIC("A")="Select BILL to CANCEL: "
S DIC("S")="I $P(^(0),""^"",4)'=""X"""
D BENT^ABMDBDIC
G XIT:'$G(ABMP("BDFN"))!$D(DUOUT)!$D(DTOUT)
;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
I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),"^",4)="X" D G XIT
.W !,"Already canceled."
.F W ! Q:$Y+4>IOSL
.S DIR(0)="E" D ^DIR K DIR
S ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
S (ABMP(0),ABMP)=0
F S ABMP=$O(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABMP)) Q:'ABMP D
.S:ABMP=ABMP("BDFN") ABMP(0)=1
.I ABMP'=ABMP("BDFN"),$D(^ABMDBILL(DUZ(2),ABMP)) S ABMP("SIS",ABMP)=""
.Q
K:'ABMP(0) ABMP("SIS")
I '$D(ABMP("SIS")) G SINGL
W !!,"The following Bills are all associated and can only be",!,"canceled in a group manner: ",ABMP("BILL")
S ABMP=""
F S ABMP=$O(ABMP("SIS",ABMP)) Q:'ABMP W ",",$P(^ABMDBILL(DUZ(2),ABMP,0),U)
W !
K DIR
S DIR(0)="YO"
S DIR("A")="Do you want to CANCEL all of these Bills (Y/N)"
D ^DIR
I Y'=1!$D(DIRUT) G XIT
G EXP
;
SINGL ;
; Cancel a single bill
K DIR
W !
S DIR(0)="YO"
S DIR("A")="Do you wish Bill Number "_ABMP("BILL")_" CANCELED (Y/N)"
D ^DIR K DIR
I Y'=1!$D(DIRUT) G XIT
;
EXP ;
; Check to see if bill was already exported "billed"
I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)="B",ABMP("BILL")'=+ABMP("BILL") D
.W *7,!!?5,"**** Bill Number ",ABMP("BILL")," was ALREADY PRINTED/EXPORTED! ****"
.S ABMP("DEL")=""
I D
.W !
.S DIR(0)="YO"
.S DIR("A")="Are you Positive that you want to CANCEL this Bill (Y/N)"
.D ^DIR K DIR
I Y'=1!$D(DIRUT) G XIT
W !!,"Canceling..."
;
OPEN ;
; If bill was manually entered, cancel it and exit
I ABMP("BILL")=+ABMP("BILL") D BKILL G XIT
; If claim does not exist cancel the bill and allow claim editing
I '$D(^ABMDCLM(DUZ(2),+ABMP("BILL"),0)) W !!,"Claim Number: ",+ABMP("BILL")," has been Canceled, thus cannot be Opened for Editing!" G TRK
L +^ABMDCLM(DUZ(2),+ABMP("BILL")):0 I '$T W !?5,*7,"Another User is Editing the CLAIM, try Later!" G XIT
S ABMP("INS")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8) ;Active ins
S DA=+ABMP("BILL")
S DIE="^ABMDCLM(DUZ(2),"
S DR=".04////E;.08////"_ABMP("INS")
D ^DIE ; mark claim in edit status and stuff active ins
K DR
S DA(1)=DA
S DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
S DA=0
; Update insurer/provider multiple
F S DA=$O(^ABMDCLM(DUZ(2),DA(1),13,DA)) Q:'DA D
.I $P(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U)=ABMP("INS")!($P($G(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11)=ABMP("INS")) D Q
..S DR=".03////I"
..D ^DIE
.I $P(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U,3)="I",($P(^(0),U)'=ABMP("INS")!($P($G(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11)'=ABMP("INS"))) D
..S DR=".03////P"
..D ^DIE
;
TRK ;
; if bill already exported. . .
I $D(ABMP("DEL")),$D(^ABPVFAC("B",ABMP("BILL"))) D
.S DIK="^ABPVFAC("
.S DA=$O(^ABPVFAC("B",ABMP("BILL"),0))
.D ^DIK
.Q
D BKILL
; If single bill. . .
I '$D(ABMP("SIS")) G MSG
; Loop through and cancel all related bills.
S ABMP("BDFN")=""
F S ABMP("BDFN")=$O(ABMP("SIS",ABMP("BDFN"))) Q:'ABMP("BDFN") D
.S ABMP("BILL")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
.D BKILL
;
MSG ;
W !,"Claim Number: ",+ABMP("BILL")," is now Open for Editing!"
G XIT
;
BKILL ;CANCEL BILL
S DIE="^ABMDBILL(DUZ(2),"
S DA=ABMP("BDFN")
S DR=".04////X;.111////"_DUZ_";.112///NOW;.113R"
S DIE("NO^")="" ;abm*2.6*11 HEAT89093
D ^DIE
D ADDBENTR^ABMUCUTL("CBILL",ABMP("BDFN")) ;add bill to UFMS Cash. Session
W !!,"Bill Number: ",ABMP("BILL")," has been Canceled!",!
Q
ABMDECAN ; IHS/ASDST/DMJ - Cancel Selected Claim ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**9,11,19,21**;NOV 12, 2009;Build 379
+2 ;
+3 ; 03/10/04 V2.5 Patch 5 - Deny cancel claim if bill attached
+4 ; IHS/SD/SDR - V2.5 P8 - Added code for cancellation reason
+5 ; IHS/SD/SDR - v2.5 p10 - IM20454 - Fix cancellation when replacement insurer present
+6 ; IHS/SD/SDR - v2.5 p12 - UFMS - If user isn't logged into cashiering session they can't do
+7 ; this option. Also added call to populate cashiering session with claim/bill number if they
+8 ; are cancelling. Also added who cancelled bill, when, and reason (.111,.112,.113)
+9 ;
+10 ;IHS/SD/SDR - 2.6*19 - HEAT155799 - Updated code that creates 3P Cancelled Claim entry so it can
+11 ; be called from the Merged claim option if user decides to delete claims that were merged.
+12 ;IHS/SD/SDR - 2.6*21 - HEAT242626 - Updated so only claims with a status of F, E or P can be cancelled.
+13 ;
+14 KILL ABMP
+15 SET U="^"
+16 SET ABMP("XMIT")=0
+17 ;
SEL ;
+1 WRITE !!
+2 DO ^ABMDEDIC
+3 IF X=""!$DATA(DUOUT)!$DATA(DTOUT)!'+$GET(ABMP("CDFN"))
GOTO XIT
+4 IF +Y<1
GOTO SEL
+5 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+6 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+7 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+8 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+9 ;end new code
+10 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+11 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+12 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+13 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+14 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
+15 ;start new abm*2.6*21 IHS/SD/SDR HEAT242626
+16 IF "^F^E^P^"'[("^"_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_"^")
Begin DoDot:1
+17 WRITE !,*7,"Claim status is ("_$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_") "_$PIECE($PIECE($PIECE(^DD(9002274.3,.04,0),U,3),$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),0)),U,4)_":",2),";")
+18 WRITE !,"Only claims with one of the below status can be cancelled:"
+19 WRITE !?3,"(F) Flagged as Billable"
+20 WRITE !?3,"(E) In Edit Mode"
+21 WRITE !?3,"(P) Pending"
End DoDot:1
GOTO SEL
+22 ;end new abm*2.6*21 IHS/SD/SDR HEAT242626
+23 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),65))
Begin DoDot:1
+24 SET ABMACBEX=0
+25 SET D1=0
+26 FOR
SET D1=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1))
IF 'D1
QUIT
Begin DoDot:2
+27 IF +^ABMDCLM(DUZ(2),ABMP("CDFN"),65,D1,0)
SET ABMACBEX=1
End DoDot:2
+28 IF $GET(ABMACBEX)
Begin DoDot:2
+29 WRITE !,*7,"An active bill exists for this claim. Cancelling of claim not allowed!"
End DoDot:2
+30 KILL D1
End DoDot:1
IF ABMACBEX
GOTO SEL
+31 KILL ABMACBEX
+32 LOCK +^ABMDCLM(DUZ(2),ABMP("CDFN")):0
IF '$TEST
WRITE !?5,*7,"Another User is Editing this Record!"
GOTO SEL
+33 DO ENT
+34 IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
GOTO SEL
+35 ;
XIT ;
+1 LOCK -^ABMDCLM(DUZ(2))
+2 KILL ABMP
+3 FOR
WRITE !
IF $Y+3>IOSL
QUIT
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 QUIT
+6 ;
ENT ;EP - to Cancel a Claim
+1 IF '$DATA(^XUSEC("ABMDZ CANCEL CLAIM",DUZ))
WRITE !!,"You don't have enough access to cancel claims",!
QUIT
+2 WRITE !,*7,"WARNING: If you cancel this Claim it will be deleted and no further Editing",!?9,"or Approvals can occur.",!
+3 ;
ENT2 ;EP - BYPASS THE WARNING
+1 SET DIR(0)="Y"
+2 SET DIR("A")="Do you wish Claim Number "_ABMP("CDFN")_" DELETED (Y/N)"
+3 DO ^DIR
+4 IF Y'=1
QUIT
+5 WRITE !
+6 ;abm*2.6*19 IHS/SD/SDR HEAT155799 - added line tag ENT3
ENT3 ;EP - Delete claim without asking
+1 SET DIE="^ABMCCLMS(DUZ(2),"
+2 SET DA=ABMP("CDFN")
+3 SET DIE("NO^")="OUTOK"
+4 ;S DR=".04////X;.114////"_DUZ_";.115///NOW;.118R~Cancellation REASON:" ;abm*2.6*19 IHS/SD/SDR HEAT155799
+5 ;abm*2.6*19 IHS/SD/SDR HEAT155799
IF $GET(ABMREAS)'=""
SET DR=".04////X;.114////"_DUZ_";.115///NOW;.118///"_ABMREAS
+6 ;abm*2.6*19 IHS/SD/SDR HEAT155799
IF $GET(ABMREAS)=""
SET DR=".04////X;.114////"_DUZ_";.115///NOW;.118R~Cancellation REASON:"
+7 DO ^DIE
+8 IF $PIECE($GET(^ABMCCLMS(DUZ(2),ABMP("CDFN"),1)),U,8)=""
Begin DoDot:1
+9 ;W !!,"CLAIM NOT CANCELLED" ;abm*2.6*19 IHS/SD/SDR HEAT155799
+10 ;abm*2.6*19 IHS/SD/SDR HEAT155799
WRITE !!,"CLAIM "_ABMP("CDFN")_" NOT CANCELLED"
+11 SET DIK="^ABMCCLMS(DUZ(2),"
+12 SET DA=ABMP("CDFN")
+13 DO ^DIK
End DoDot:1
QUIT
+14 MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),0)=^ABMDCLM(DUZ(2),ABMP("CDFN"),0)
+15 ;PCC Visits
MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),11)=^ABMDCLM(DUZ(2),ABMP("CDFN"),11)
+16 ;Providers
MERGE ^ABMCCLMS(DUZ(2),ABMP("CDFN"),41)=^ABMDCLM(DUZ(2),ABMP("CDFN"),41)
+17 SET DIK="^ABMCCLMS(DUZ(2),"
+18 SET DA=ABMP("CDFN")
+19 ;merged entries don't x-ref
DO IX^DIK
+20 WRITE !!,"OK, the claim is being deleted..."
+21 SET DR=".04///1"
DO KCLM
+22 WRITE !!,"Claim Number: ",ABMP("CDFN")," has been Deleted!"
+23 SET ^ABMDTMP("KCLM",DT,ABMP("CDFN"))=DUZ
+24 QUIT
+25 ;
KCLM ;EP for Deleting Claim
+1 SET DIE="^AUPNVSIT("
+2 SET DA=0
FOR
SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,DA))
IF 'DA
QUIT
Begin DoDot:1
+3 IF $ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),""))]""
QUIT
+4 IF '$DATA(^AUPNVSIT(DA,0))
QUIT
+5 DO ^ABMDDIE
End DoDot:1
+6 SET DA=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),15,0))
+7 IF DA
Begin DoDot:1
+8 IF $ORDER(^ABMDBILL(DUZ(2),"AS",ABMP("CDFN"),""))]""
QUIT
+9 IF '$DATA(^AAPCRCDS(DA,0))
QUIT
+10 SET ^AAPCRCDS("ACAN",DA)=ABMP("CDFN")
End DoDot:1
+11 ;add clm to UFMS Cash. Session
IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
DO ADDBENTR^ABMUCUTL("CCLM",ABMP("CDFN"))
+12 SET DIK="^ABMDCLM(DUZ(2),"
+13 SET DA=ABMP("CDFN")
+14 DO ^ABMDEDIK
+15 QUIT
+16 ;
BILL ;EP - to cancel a Bill
+1 WRITE !
+2 KILL ABMP
+3 SET U="^"
+4 SET ABMP("XMIT")=0
+5 ;
BSEL ;
+1 ; Ask the user which bill to cancel
+2 KILL DIC
+3 SET DIC="^ABMDBILL(DUZ(2),"
+4 SET DIC(0)="QEAM"
+5 SET DIC("A")="Select BILL to CANCEL: "
+6 SET DIC("S")="I $P(^(0),""^"",4)'=""X"""
+7 DO BENT^ABMDBDIC
+8 IF '$GET(ABMP("BDFN"))!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+9 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+10 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+11 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+12 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+13 ;end new code
+14 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+15 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+16 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+17 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+18 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
+19 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),"^",4)="X"
Begin DoDot:1
+20 WRITE !,"Already canceled."
+21 FOR
WRITE !
IF $Y+4>IOSL
QUIT
+22 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
GOTO XIT
+23 SET ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
+24 SET (ABMP(0),ABMP)=0
+25 FOR
SET ABMP=$ORDER(^ABMDCLM(DUZ(2),+ABMP("BILL"),65,ABMP))
IF 'ABMP
QUIT
Begin DoDot:1
+26 IF ABMP=ABMP("BDFN")
SET ABMP(0)=1
+27 IF ABMP'=ABMP("BDFN")
IF $DATA(^ABMDBILL(DUZ(2),ABMP))
SET ABMP("SIS",ABMP)=""
+28 QUIT
End DoDot:1
+29 IF 'ABMP(0)
KILL ABMP("SIS")
+30 IF '$DATA(ABMP("SIS"))
GOTO SINGL
+31 WRITE !!,"The following Bills are all associated and can only be",!,"canceled in a group manner: ",ABMP("BILL")
+32 SET ABMP=""
+33 FOR
SET ABMP=$ORDER(ABMP("SIS",ABMP))
IF 'ABMP
QUIT
WRITE ",",$PIECE(^ABMDBILL(DUZ(2),ABMP,0),U)
+34 WRITE !
+35 KILL DIR
+36 SET DIR(0)="YO"
+37 SET DIR("A")="Do you want to CANCEL all of these Bills (Y/N)"
+38 DO ^DIR
+39 IF Y'=1!$DATA(DIRUT)
GOTO XIT
+40 GOTO EXP
+41 ;
SINGL ;
+1 ; Cancel a single bill
+2 KILL DIR
+3 WRITE !
+4 SET DIR(0)="YO"
+5 SET DIR("A")="Do you wish Bill Number "_ABMP("BILL")_" CANCELED (Y/N)"
+6 DO ^DIR
KILL DIR
+7 IF Y'=1!$DATA(DIRUT)
GOTO XIT
+8 ;
EXP ;
+1 ; Check to see if bill was already exported "billed"
+2 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,4)="B"
IF ABMP("BILL")'=+ABMP("BILL")
Begin DoDot:1
+3 WRITE *7,!!?5,"**** Bill Number ",ABMP("BILL")," was ALREADY PRINTED/EXPORTED! ****"
+4 SET ABMP("DEL")=""
End DoDot:1
+5 IF $TEST
Begin DoDot:1
+6 WRITE !
+7 SET DIR(0)="YO"
+8 SET DIR("A")="Are you Positive that you want to CANCEL this Bill (Y/N)"
+9 DO ^DIR
KILL DIR
End DoDot:1
+10 IF Y'=1!$DATA(DIRUT)
GOTO XIT
+11 WRITE !!,"Canceling..."
+12 ;
OPEN ;
+1 ; If bill was manually entered, cancel it and exit
+2 IF ABMP("BILL")=+ABMP("BILL")
DO BKILL
GOTO XIT
+3 ; If claim does not exist cancel the bill and allow claim editing
+4 IF '$DATA(^ABMDCLM(DUZ(2),+ABMP("BILL"),0))
WRITE !!,"Claim Number: ",+ABMP("BILL")," has been Canceled, thus cannot be Opened for Editing!"
GOTO TRK
+5 LOCK +^ABMDCLM(DUZ(2),+ABMP("BILL")):0
IF '$TEST
WRITE !?5,*7,"Another User is Editing the CLAIM, try Later!"
GOTO XIT
+6 ;Active ins
SET ABMP("INS")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U,8)
+7 SET DA=+ABMP("BILL")
+8 SET DIE="^ABMDCLM(DUZ(2),"
+9 SET DR=".04////E;.08////"_ABMP("INS")
+10 ; mark claim in edit status and stuff active ins
DO ^DIE
+11 KILL DR
+12 SET DA(1)=DA
+13 SET DIE="^ABMDCLM(DUZ(2),"_DA(1)_",13,"
+14 SET DA=0
+15 ; Update insurer/provider multiple
+16 FOR
SET DA=$ORDER(^ABMDCLM(DUZ(2),DA(1),13,DA))
IF 'DA
QUIT
Begin DoDot:1
+17 IF $PIECE(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U)=ABMP("INS")!($PIECE($GET(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11)=ABMP("INS"))
Begin DoDot:2
+18 SET DR=".03////I"
+19 DO ^DIE
End DoDot:2
QUIT
+20 IF $PIECE(^ABMDCLM(DUZ(2),DA(1),13,DA,0),U,3)="I"
IF ($PIECE(^(0),U)'=ABMP("INS")!($PIECE($GET(^ABMDCLM(DUZ(2),DA(1),13,DA,0)),U,11)'=ABMP("INS")))
Begin DoDot:2
+21 SET DR=".03////P"
+22 DO ^DIE
End DoDot:2
End DoDot:1
+23 ;
TRK ;
+1 ; if bill already exported. . .
+2 IF $DATA(ABMP("DEL"))
IF $DATA(^ABPVFAC("B",ABMP("BILL")))
Begin DoDot:1
+3 SET DIK="^ABPVFAC("
+4 SET DA=$ORDER(^ABPVFAC("B",ABMP("BILL"),0))
+5 DO ^DIK
+6 QUIT
End DoDot:1
+7 DO BKILL
+8 ; If single bill. . .
+9 IF '$DATA(ABMP("SIS"))
GOTO MSG
+10 ; Loop through and cancel all related bills.
+11 SET ABMP("BDFN")=""
+12 FOR
SET ABMP("BDFN")=$ORDER(ABMP("SIS",ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:1
+13 SET ABMP("BILL")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),U)
+14 DO BKILL
End DoDot:1
+15 ;
MSG ;
+1 WRITE !,"Claim Number: ",+ABMP("BILL")," is now Open for Editing!"
+2 GOTO XIT
+3 ;
BKILL ;CANCEL BILL
+1 SET DIE="^ABMDBILL(DUZ(2),"
+2 SET DA=ABMP("BDFN")
+3 SET DR=".04////X;.111////"_DUZ_";.112///NOW;.113R"
+4 ;abm*2.6*11 HEAT89093
SET DIE("NO^")=""
+5 DO ^DIE
+6 ;add bill to UFMS Cash. Session
DO ADDBENTR^ABMUCUTL("CBILL",ABMP("BDFN"))
+7 WRITE !!,"Bill Number: ",ABMP("BILL")," has been Canceled!",!
+8 QUIT
