ABMDE2 ; IHS/ASDST/DMJ - Edit Page 2 - PAYERS ;
;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,21**;NOV 12, 2009;Build 379
;
;IHS/SD/SDR - 10/29/02 - V2.5 P2 - NHA-0402-180088
; Modified so it would allow the deletion of insurer from page 2 if accident or work related claim.
;IHS/SD/SDR - v2.5 p8 - IM15307/IM14092 - Modified to display MSP error on page if applicable
;IHS/SD/SDR - v2.5 p8 - task 8 - Added code to display replacment insurer
;IHS/SD/SDR - v2.5 p9 - IM19040 - Added ability to delete insurers all the time
;IHS/SD/SDR - v2.5 p10 - IM20593 - Changed default for MSP reason to NO MSP ON FILE
;
;IHS/SD/SDR - 2.6*21 - HEAT131494 - Changed code to populate priority for added insurer. It wasn't being
; populated so insurer wasn't showing up on display.
;IHS/SD/SDR - 2.6*21 - HEAT238757 - Fixed so ADD option shows up all the time, nut just when an accident/employment related claim.
;
OPT ;
K ABM,ABME,ABMV,ABMG
S ABMZ("NUM")=""
;S ABMP("OPT")="DPVNJBQ" ;abm*2.6*6 NOHEAT
S ABMP("OPT")="ADPVNJBQ" ;abm*2.6*6 NOHEAT
;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)="Y") S ABMP("OPT")="A"_ABMP("OPT") ;abm*2.6*21 IHS/SD/SDR HEAT238757
I $D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))=10 D
.I $O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))="" D
..S ABMP("OPT")=$P(ABMP("OPT"),"P")_$P(ABMP("OPT"),"P",2)
S ABMZ("PG")="1,2,7"
D DISP
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)="" ABMP("DFLT")="P"
I ABMZ("NUM")=0 D
.S ABMP("DFLT")="Q"
.S ABMP("OPT")="BQ"
D:$D(ABMW)=10 ^ABMDWARN
W !
D SEL^ABMDEOPT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!("VPAD"'[$E(Y))
S ABM("DO")=$S($E(Y)="C":"^ABMDECK",$E(Y)="V":"V1^ABMDE2A",$E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1",1:"^ABMDE2P")
D @ABM("DO")
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!$D(ABMP("OVER"))
G OPT
;
; *********************************************************************
DISP ;
S ABMZ("TITL")="INSURERS"
S ABMZ("PG")=2
I $D(ABMP("DDL")),$Y>(IOSL-9) D Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) I 1
. D PAUSE^ABMDE1
E D SUM^ABMDE1
I $P(ABMP("C0"),U,8)="" G INSR
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
D ^ABMDE2X
D ^ABMDE2X1
;start old code abm*2.6*8 HEAT34042
;W:$D(ABMP("VTYP",999)) ?68,"Prof-Comp"
;W !,"To: ",$P(ABMV("X5"),U)
;W ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
;W:$D(ABMP("VTYP",999)) ?68,"========="
;W !?4,$P(ABMV("X5"),U,2)
;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
;I $D(ABMP("VTYP",999)) D
;.I '$D(ABMP("FLAT")) D Q
;..W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
;.W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9")
;W !?4,$P(ABMV("X5"),U,3)
;W ?40,"Export Mode.: "
;I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
;W:$G(ABMP("VTYP",999)) ?68,$P(^ABMDEXP(ABMP("VTYP",999),0),U)
;W !?4,$P(ABMV("X5"),U,4)
;W ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
;W:$D(ABMP("VTYP",999)) ?68,$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
;end old code start new code HEAT34042
I $P(ABMV("X6"),U,6)="Y" D
.W:$D(ABMP("VTYP",999)) ?68,"Prof-Comp"
.W !,"To: ",$P(ABMV("X5"),U)
.W ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
.W:$D(ABMP("VTYP",999)) ?68,"========="
.W !?4,$P(ABMV("X5"),U,2)
.;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
.W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
.I $D(ABMP("VTYP",999)) D
..I '$D(ABMP("FLAT")) D Q
...;W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
...W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
..;W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
..W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
.W !?4,$P(ABMV("X5"),U,3)
.W ?40,"Export Mode.: "
.I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
.W:$G(ABMP("VTYP",999)) ?68,$P(^ABMDEXP(ABMP("VTYP",999),0),U)
.W !?4,$P(ABMV("X5"),U,4)
.W ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
.W:$D(ABMP("VTYP",999)) ?68,$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
I ($P(ABMV("X6"),U,6)="")!($P(ABMV("X6"),U,6)="N") D ;if null or NO
.W:$D(ABMP("VTYP",999)) ?54,"Prof-Comp"
.W !,"To: ",$P(ABMV("X5"),U)
.W:'$D(ABMP("VTYP",999)) ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
.W:$D(ABMP("VTYP",999)) ?54,"========="
.W !?4,$P(ABMV("X5"),U,2)
.;W:'$D(ABMP("VTYP",999)) ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
.W:'$D(ABMP("VTYP",999)) ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
.I $D(ABMP("VTYP",999)) D
..I '$D(ABMP("FLAT")) D Q
...;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
...W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
..;W ?40,"Proc. Code..: ",$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
..W ?40,"Proc. Code..: ",$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD") ;abm*2.6*10 ICD10 002D
.W !?4,$P(ABMV("X5"),U,3)
.I '$D(ABMP("VTYP",999)) W ?40,"Export Mode.: " I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
.I $G(ABMP("VTYP",999)) W ?40,"Export Mode.: ",$P(^ABMDEXP(ABMP("VTYP",999),0),U)
.W !?4,$P(ABMV("X5"),U,4)
.W:'$D(ABMP("VTYP",999)) ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
.W:$D(ABMP("VTYP",999)) ?40,"Flat Rate...: ",$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
;end new code HEAT34042
S ABMX=""
S $P(ABMX,".",80)=""
W !,ABMX,!
I $D(^AUPNMSP("C",ABMP("PDFN"))) D
.K ABMMSP,ABMFLAG,ABMMSPSV
.; get correct entry based on visit date
.S ABMMSP=9999999,ABMFLAG="",ABMMSPSV=9999999
.F S ABMMSP=$O(^AUPNMSP("C",ABMP("PDFN"),ABMMSP),-1) Q:ABMMSP="" D Q:ABMFLAG=1
..I $G(ABMMSPSV)="" S ABMMSPSV=ABMMSP
..I (ABMP("VDT")<ABMMSPSV&(ABMP("VDT")>ABMMSP))!(ABMMSP=ABMP("VDT")) S ABMMSPSV=$O(^AUPNMSP("C",ABMP("PDFN"),ABMMSP,0)),ABMFLAG=1 Q
..I ABMP("VDT")=ABMMSP S ABMFLAG=1 Q
..S ABMMSPSV=ABMMSP
.; write the entry with date
.I ABMFLAG=1 D
..K %DT ;abm*2.6*8
..S Y=ABMMSP
..D DD^%DT
..S ABMMSPDT=Y
..K %DT ;abm*2.6*8
..S ABMMSPRS=$S($G(ABMMSPSV)="":"NO REASON ENTERED",$P($G(^AUPNMSP(ABMMSPSV,0)),U,4)'="":$P($G(^AUPNMSP(ABMMSPSV,0)),U,4),1:"NO REASON ENTERED")
..W "MSP STATUS AS OF "_ABMMSPDT_": "
..I $G(ABMMSPSV)'="",$P($G(^AUPNMSP(ABMMSPSV,0)),U,3)["Y" W "["_ABMMSPRS_"]-"_$$GET1^DIQ(9000037,ABMMSPSV,.04)
..E W "NOT MSP ELIGIBLE"
..W !,ABMX,!
.K ABMFLAG,ABMMSPSV
K ABMX
K ABMMSPDT
;
INSR ; Insurer Info
S ABMZ("SUB")=13
S ABMZ("DR")=";.03////P"
S ABMZ("ITEM")="Payer"
S ABMZ("DIC")="^AUTNINS("
S ABMZ("X")="X"
I $Y>(IOSL-8) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
D HD
G LOOP
;
;**********************************************************************
HD ;
W !?13,"BILLING ENTITY",?39,"STATUS",?52,"POLICY HOLDER"
W !,?5,"==============================",?37,"==========",?49,"=============================="
Q
;
; *********************************************************************
LOOP ;LOOP HERE
S (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABMZ("UNBILL"))=0
S ABM=""
F ABM("I")=1:1 S ABM=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM)) Q:'ABM D
.S ABM("XIEN")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,""))
.S ABM("X")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U)
.D INS
;S ABMZ("DR2")=";.02////"_(ABMZ("LNUM")+1) ;abm*2.6*21 IHS/SD/SDR HEAT131494
S ABMZ("DR")=ABMZ("DR")_";.02////"_(ABMZ("LNUM")+1) ;abm*2.6*21 IHS/SD/SDR HEAT131494
I ABMZ("NUM")=0 W *7,!?5,"*** ERROR: No "_ABMZ("ITEM")_" Exists, at Least One is Required! ***",!
K ABME
S ABME("CONT")=""
S ABM("E")=0
F S ABM("E")=$O(ABMG(ABM("E"))) Q:'ABM("E") D
. S ABME(ABM("E"))=ABMG(ABM("E"))
D ^ABMDERR
K ABME("CONT")
Q
;
; *********************************************************************
INS ;
Q:'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0))
Q:$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U,3)=""
S ABMZ("NUM")=ABM("I")
S ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)
S:ABMZ("LNUM")<$P(ABM("X0"),U,2) ABMZ("LNUM")=$P(ABM("X0"),U,2)
I $Y>(IOSL-5) D PAUSE^ABMDE1 Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) D HD
I $P(ABM("X0"),U,3)="C" D
.S ABMZ("UNBILL")=ABMZ("UNBILL")+1
.S ABMZ("UNBILL",ABM("I"))=""
S ABMZ(ABM("I"))=$P(^AUTNINS(ABM("X"),0),U)_U_ABM("X")_U_ABM("XIEN")_U_$P(ABM("X0"),U,3,9)
S Y=ABM("X")
S ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
D SEL^ABMDE2X
S ABM("Y0")=""
S ABM("Y")=$P(ABM("X0"),U,3)
I ABM("Y")]"" D
.S ABM("Y0")=$P(^DD(9002274.3013,.03,0),U,3)
.S ABM("Y0")=$P($P(ABM("Y0"),ABM("Y")_":",2),";",1)
W !,"[",ABM("I"),"]"
I +$P(ABMV("X1"),U)=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U),($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U,11)'="") D
.W ?4,"*"
.W $P($G(^AUTNINS($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$P(ABMZ(ABM("I")),U,3),0)),U,11),0)),U)
E W ?5,$P(ABMZ(ABM("I")),U)
W ?37,ABM("Y0")
W ?49,$P($P(ABMV("X2"),U),";",2)
I ABM("Y")="I" S ABM("E")=0 F S ABM("E")=$O(ABME(ABM("E"))) Q:'ABM("E") S ABMG(ABM("E"))=ABME(ABM("E"))
;S ABM("PRI")=$S($P($G(^AUTNINS(ABM("X"),2)),U)="D":4,"MR"[$P($G(^(2)),U):3,$P($G(^(2)),U)="H":2,1:1) ;abm*2.6*10 HEAT73780
S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("X"),".211","I"),1,"I") ;abm*2.6*10 HEAT73780
S ABM("PRI")=$S(ABMITYP="D":4,"MR"[ABMITYP:3,ABMITYP="H":2,1:1) ;abm*2.6*10 HEAT73780
S ABM(ABM("PRI"))=""
Q
;
D1 ;EP - Delete Insurer Multiple on claim
I +$E(Y,2,3)>0&(+$E(Y,2,3)<(ABMZ("NUM")+1)) S Y=+$E(Y,2,3) G D2
I ABMZ("NUM")=1 S Y=1 G D2
I ABMZ("NUM")<1 D G DXIT
.W !,"There is no ",ABMZ("ITEM")," to delete."
.H 3
K DIR S DIR(0)="NO^1:"_ABMZ("NUM")_":0"
S DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Delete"
S DIR("A")="Sequence Number to DELETE"
D ^DIR
K DIR
G DXIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(Y'>0)
D2 I ABMZ("NUM")=1 W !,"Cannot delete only insurer on claim!" H 1 Q
W ! S ABMX("ANS")=+Y K DIR S DIR(0)="YO"
I $P(ABMZ(ABMX("ANS")),U,4)="I" W !,"Cannot delete active insurer!" H 1 Q
S DIR("A")="Do you wish "_$P(ABMZ(ABMX("ANS")),U,1)_" DELETED"
D ^DIR K DIR
Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
D3 I Y=1 D
.S DA(1)=ABMP("CDFN")
.S DA=$P(ABMZ(ABMX("ANS")),U,3)
.S DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
.D ^DIK
DXIT K ABMX
Q
XIT K ABM,ABMG
Q
ABMDE2 ; IHS/ASDST/DMJ - Edit Page 2 - PAYERS ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,8,10,21**;NOV 12, 2009;Build 379
+2 ;
+3 ;IHS/SD/SDR - 10/29/02 - V2.5 P2 - NHA-0402-180088
+4 ; Modified so it would allow the deletion of insurer from page 2 if accident or work related claim.
+5 ;IHS/SD/SDR - v2.5 p8 - IM15307/IM14092 - Modified to display MSP error on page if applicable
+6 ;IHS/SD/SDR - v2.5 p8 - task 8 - Added code to display replacment insurer
+7 ;IHS/SD/SDR - v2.5 p9 - IM19040 - Added ability to delete insurers all the time
+8 ;IHS/SD/SDR - v2.5 p10 - IM20593 - Changed default for MSP reason to NO MSP ON FILE
+9 ;
+10 ;IHS/SD/SDR - 2.6*21 - HEAT131494 - Changed code to populate priority for added insurer. It wasn't being
+11 ; populated so insurer wasn't showing up on display.
+12 ;IHS/SD/SDR - 2.6*21 - HEAT238757 - Fixed so ADD option shows up all the time, nut just when an accident/employment related claim.
+13 ;
OPT ;
+1 KILL ABM,ABME,ABMV,ABMG
+2 SET ABMZ("NUM")=""
+3 ;S ABMP("OPT")="DPVNJBQ" ;abm*2.6*6 NOHEAT
+4 ;abm*2.6*6 NOHEAT
SET ABMP("OPT")="ADPVNJBQ"
+5 ;I $P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),8)),U,3)!($P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),9)),U)="Y") S ABMP("OPT")="A"_ABMP("OPT") ;abm*2.6*21 IHS/SD/SDR HEAT238757
+6 IF $DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))=10
Begin DoDot:1
+7 IF $ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",1))=""
Begin DoDot:2
+8 SET ABMP("OPT")=$PIECE(ABMP("OPT"),"P")_$PIECE(ABMP("OPT"),"P",2)
End DoDot:2
End DoDot:1
+9 SET ABMZ("PG")="1,2,7"
+10 DO DISP
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
+12 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,8)=""
SET ABMP("DFLT")="P"
+13 IF ABMZ("NUM")=0
Begin DoDot:1
+14 SET ABMP("DFLT")="Q"
+15 SET ABMP("OPT")="BQ"
End DoDot:1
+16 IF $DATA(ABMW)=10
DO ^ABMDWARN
+17 WRITE !
+18 DO SEL^ABMDEOPT
+19 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!("VPAD"'[$EXTRACT(Y))
GOTO XIT
+20 SET ABM("DO")=$SELECT($EXTRACT(Y)="C":"^ABMDECK",$EXTRACT(Y)="V":"V1^ABMDE2A",$EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="D":"D1",1:"^ABMDE2P")
+21 DO @ABM("DO")
+22 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!$DATA(ABMP("OVER"))
GOTO XIT
+23 GOTO OPT
+24 ;
+25 ; *********************************************************************
DISP ;
+1 SET ABMZ("TITL")="INSURERS"
+2 SET ABMZ("PG")=2
+3 IF $DATA(ABMP("DDL"))
IF $Y>(IOSL-9)
Begin DoDot:1
+4 DO PAUSE^ABMDE1
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
IF 1
+5 IF '$TEST
DO SUM^ABMDE1
+6 IF $PIECE(ABMP("C0"),U,8)=""
GOTO INSR
+7 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+8 DO ^ABMDE2X
+9 DO ^ABMDE2X1
+10 ;start old code abm*2.6*8 HEAT34042
+11 ;W:$D(ABMP("VTYP",999)) ?68,"Prof-Comp"
+12 ;W !,"To: ",$P(ABMV("X5"),U)
+13 ;W ?40,"Bill Type...: ",$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
+14 ;W:$D(ABMP("VTYP",999)) ?68,"========="
+15 ;W !?4,$P(ABMV("X5"),U,2)
+16 ;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
+17 ;I $D(ABMP("VTYP",999)) D
+18 ;.I '$D(ABMP("FLAT")) D Q
+19 ;..W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9")
+20 ;.W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9")
+21 ;W !?4,$P(ABMV("X5"),U,3)
+22 ;W ?40,"Export Mode.: "
+23 ;I +ABMV("X6") W $P($G(^ABMDEXP(+ABMV("X6"),0)),U)
+24 ;W:$G(ABMP("VTYP",999)) ?68,$P(^ABMDEXP(ABMP("VTYP",999),0),U)
+25 ;W !?4,$P(ABMV("X5"),U,4)
+26 ;W ?40,"Flat Rate...: ",$S(+$P(ABMV("X6"),U,5):$J($P(ABMV("X6"),U,5),4,2),1:"N/A")
+27 ;W:$D(ABMP("VTYP",999)) ?68,$S('$D(ABMP("FLAT")):"N/A",$P(ABMP("FLAT"),U,4)]"":$J($P(ABMP("FLAT"),U,4),4,2),1:"N/A")
+28 ;end old code start new code HEAT34042
+29 IF $PIECE(ABMV("X6"),U,6)="Y"
Begin DoDot:1
+30 IF $DATA(ABMP("VTYP",999))
WRITE ?68,"Prof-Comp"
+31 WRITE !,"To: ",$PIECE(ABMV("X5"),U)
+32 WRITE ?40,"Bill Type...: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
+33 IF $DATA(ABMP("VTYP",999))
WRITE ?68,"========="
+34 WRITE !?4,$PIECE(ABMV("X5"),U,2)
+35 ;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+36 ;abm*2.6*10 ICD10 002D
WRITE ?40,"Proc. Code..: ",$SELECT($PIECE(ABMV("X6"),U,2)="C":"CPT4",$PIECE(ABMV("X6"),U,2)="A":"ADA",1:"ICD")
+37 IF $DATA(ABMP("VTYP",999))
Begin DoDot:2
+38 IF '$DATA(ABMP("FLAT"))
Begin DoDot:3
+39 ;W ?68,$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+40 ;abm*2.6*10 ICD10 002D
WRITE ?68,$SELECT($PIECE(ABMV("X6"),U,2)="C":"CPT4",$PIECE(ABMV("X6"),U,2)="A":"ADA",1:"ICD")
End DoDot:3
QUIT
+41 ;W ?68,$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+42 ;abm*2.6*10 ICD10 002D
WRITE ?68,$SELECT($PIECE(ABMP("FLAT"),U,5)="C":"CPT4",$PIECE(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD")
End DoDot:2
+43 WRITE !?4,$PIECE(ABMV("X5"),U,3)
+44 WRITE ?40,"Export Mode.: "
+45 IF +ABMV("X6")
WRITE $PIECE($GET(^ABMDEXP(+ABMV("X6"),0)),U)
+46 IF $GET(ABMP("VTYP",999))
WRITE ?68,$PIECE(^ABMDEXP(ABMP("VTYP",999),0),U)
+47 WRITE !?4,$PIECE(ABMV("X5"),U,4)
+48 WRITE ?40,"Flat Rate...: ",$SELECT(+$PIECE(ABMV("X6"),U,5):$JUSTIFY($PIECE(ABMV("X6"),U,5),4,2),1:"N/A")
+49 IF $DATA(ABMP("VTYP",999))
WRITE ?68,$SELECT('$DATA(ABMP("FLAT")):"N/A",$PIECE(ABMP("FLAT"),U,4)]"":$JUSTIFY($PIECE(ABMP("FLAT"),U,4),4,2),1:"N/A")
End DoDot:1
+50 ;if null or NO
IF ($PIECE(ABMV("X6"),U,6)="")!($PIECE(ABMV("X6"),U,6)="N")
Begin DoDot:1
+51 IF $DATA(ABMP("VTYP",999))
WRITE ?54,"Prof-Comp"
+52 WRITE !,"To: ",$PIECE(ABMV("X5"),U)
+53 IF '$DATA(ABMP("VTYP",999))
WRITE ?40,"Bill Type...: ",$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),"^",12)
+54 IF $DATA(ABMP("VTYP",999))
WRITE ?54,"========="
+55 WRITE !?4,$PIECE(ABMV("X5"),U,2)
+56 ;W:'$D(ABMP("VTYP",999)) ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+57 ;abm*2.6*10 ICD10 002D
IF '$DATA(ABMP("VTYP",999))
WRITE ?40,"Proc. Code..: ",$SELECT($PIECE(ABMV("X6"),U,2)="C":"CPT4",$PIECE(ABMV("X6"),U,2)="A":"ADA",1:"ICD")
+58 IF $DATA(ABMP("VTYP",999))
Begin DoDot:2
+59 IF '$DATA(ABMP("FLAT"))
Begin DoDot:3
+60 ;W ?40,"Proc. Code..: ",$S($P(ABMV("X6"),U,2)="C":"CPT4",$P(ABMV("X6"),U,2)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+61 ;abm*2.6*10 ICD10 002D
WRITE ?40,"Proc. Code..: ",$SELECT($PIECE(ABMV("X6"),U,2)="C":"CPT4",$PIECE(ABMV("X6"),U,2)="A":"ADA",1:"ICD")
End DoDot:3
QUIT
+62 ;W ?40,"Proc. Code..: ",$S($P(ABMP("FLAT"),U,5)="C":"CPT4",$P(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD9") ;abm*2.6*10 ICD10 002D
+63 ;abm*2.6*10 ICD10 002D
WRITE ?40,"Proc. Code..: ",$SELECT($PIECE(ABMP("FLAT"),U,5)="C":"CPT4",$PIECE(ABMP("FLAT"),U,5)="A":"ADA",1:"ICD")
End DoDot:2
+64 WRITE !?4,$PIECE(ABMV("X5"),U,3)
+65 IF '$DATA(ABMP("VTYP",999))
WRITE ?40,"Export Mode.: "
IF +ABMV("X6")
WRITE $PIECE($GET(^ABMDEXP(+ABMV("X6"),0)),U)
+66 IF $GET(ABMP("VTYP",999))
WRITE ?40,"Export Mode.: ",$PIECE(^ABMDEXP(ABMP("VTYP",999),0),U)
+67 WRITE !?4,$PIECE(ABMV("X5"),U,4)
+68 IF '$DATA(ABMP("VTYP",999))
WRITE ?40,"Flat Rate...: ",$SELECT(+$PIECE(ABMV("X6"),U,5):$JUSTIFY($PIECE(ABMV("X6"),U,5),4,2),1:"N/A")
+69 IF $DATA(ABMP("VTYP",999))
WRITE ?40,"Flat Rate...: ",$SELECT('$DATA(ABMP("FLAT")):"N/A",$PIECE(ABMP("FLAT"),U,4)]"":$JUSTIFY($PIECE(ABMP("FLAT"),U,4),4,2),1:"N/A")
End DoDot:1
+70 ;end new code HEAT34042
+71 SET ABMX=""
+72 SET $PIECE(ABMX,".",80)=""
+73 WRITE !,ABMX,!
+74 IF $DATA(^AUPNMSP("C",ABMP("PDFN")))
Begin DoDot:1
+75 KILL ABMMSP,ABMFLAG,ABMMSPSV
+76 ; get correct entry based on visit date
+77 SET ABMMSP=9999999
SET ABMFLAG=""
SET ABMMSPSV=9999999
+78 FOR
SET ABMMSP=$ORDER(^AUPNMSP("C",ABMP("PDFN"),ABMMSP),-1)
IF ABMMSP=""
QUIT
Begin DoDot:2
+79 IF $GET(ABMMSPSV)=""
SET ABMMSPSV=ABMMSP
+80 IF (ABMP("VDT")<ABMMSPSV&(ABMP("VDT")>ABMMSP))!(ABMMSP=ABMP("VDT"))
SET ABMMSPSV=$ORDER(^AUPNMSP("C",ABMP("PDFN"),ABMMSP,0))
SET ABMFLAG=1
QUIT
+81 IF ABMP("VDT")=ABMMSP
SET ABMFLAG=1
QUIT
+82 SET ABMMSPSV=ABMMSP
End DoDot:2
IF ABMFLAG=1
QUIT
+83 ; write the entry with date
+84 IF ABMFLAG=1
Begin DoDot:2
+85 ;abm*2.6*8
KILL %DT
+86 SET Y=ABMMSP
+87 DO DD^%DT
+88 SET ABMMSPDT=Y
+89 ;abm*2.6*8
KILL %DT
+90 SET ABMMSPRS=$SELECT($GET(ABMMSPSV)="":"NO REASON ENTERED",$PIECE($GET(^AUPNMSP(ABMMSPSV,0)),U,4)'="":$PIECE($GET(^AUPNMSP(ABMMSPSV,0)),U,4),1:"NO REASON ENTERED")
+91 WRITE "MSP STATUS AS OF "_ABMMSPDT_": "
+92 IF $GET(ABMMSPSV)'=""
IF $PIECE($GET(^AUPNMSP(ABMMSPSV,0)),U,3)["Y"
WRITE "["_ABMMSPRS_"]-"_$$GET1^DIQ(9000037,ABMMSPSV,.04)
+93 IF '$TEST
WRITE "NOT MSP ELIGIBLE"
+94 WRITE !,ABMX,!
End DoDot:2
+95 KILL ABMFLAG,ABMMSPSV
End DoDot:1
+96 KILL ABMX
+97 KILL ABMMSPDT
+98 ;
INSR ; Insurer Info
+1 SET ABMZ("SUB")=13
+2 SET ABMZ("DR")=";.03////P"
+3 SET ABMZ("ITEM")="Payer"
+4 SET ABMZ("DIC")="^AUTNINS("
+5 SET ABMZ("X")="X"
+6 IF $Y>(IOSL-8)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+7 DO HD
+8 GOTO LOOP
+9 ;
+10 ;**********************************************************************
HD ;
+1 WRITE !?13,"BILLING ENTITY",?39,"STATUS",?52,"POLICY HOLDER"
+2 WRITE !,?5,"==============================",?37,"==========",?49,"=============================="
+3 QUIT
+4 ;
+5 ; *********************************************************************
LOOP ;LOOP HERE
+1 SET (ABMZ("LNUM"),ABMZ("NUM"),ABMZ(1),ABMZ("UNBILL"))=0
+2 SET ABM=""
+3 FOR ABM("I")=1:1
SET ABM=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM))
IF 'ABM
QUIT
Begin DoDot:1
+4 SET ABM("XIEN")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,"C",ABM,""))
+5 SET ABM("X")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U)
+6 DO INS
End DoDot:1
+7 ;S ABMZ("DR2")=";.02////"_(ABMZ("LNUM")+1) ;abm*2.6*21 IHS/SD/SDR HEAT131494
+8 ;abm*2.6*21 IHS/SD/SDR HEAT131494
SET ABMZ("DR")=ABMZ("DR")_";.02////"_(ABMZ("LNUM")+1)
+9 IF ABMZ("NUM")=0
WRITE *7,!?5,"*** ERROR: No "_ABMZ("ITEM")_" Exists, at Least One is Required! ***",!
+10 KILL ABME
+11 SET ABME("CONT")=""
+12 SET ABM("E")=0
+13 FOR
SET ABM("E")=$ORDER(ABMG(ABM("E")))
IF 'ABM("E")
QUIT
Begin DoDot:1
+14 SET ABME(ABM("E"))=ABMG(ABM("E"))
End DoDot:1
+15 DO ^ABMDERR
+16 KILL ABME("CONT")
+17 QUIT
+18 ;
+19 ; *********************************************************************
INS ;
+1 IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0))
QUIT
+2 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0),U,3)=""
QUIT
+3 SET ABMZ("NUM")=ABM("I")
+4 SET ABM("X0")=^ABMDCLM(DUZ(2),ABMP("CDFN"),13,ABM("XIEN"),0)
+5 IF ABMZ("LNUM")<$PIECE(ABM("X0"),U,2)
SET ABMZ("LNUM")=$PIECE(ABM("X0"),U,2)
+6 IF $Y>(IOSL-5)
DO PAUSE^ABMDE1
IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
DO HD
+7 IF $PIECE(ABM("X0"),U,3)="C"
Begin DoDot:1
+8 SET ABMZ("UNBILL")=ABMZ("UNBILL")+1
+9 SET ABMZ("UNBILL",ABM("I"))=""
End DoDot:1
+10 SET ABMZ(ABM("I"))=$PIECE(^AUTNINS(ABM("X"),0),U)_U_ABM("X")_U_ABM("XIEN")_U_$PIECE(ABM("X0"),U,3,9)
+11 SET Y=ABM("X")
+12 SET ABMP("GL")="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","
+13 DO SEL^ABMDE2X
+14 SET ABM("Y0")=""
+15 SET ABM("Y")=$PIECE(ABM("X0"),U,3)
+16 IF ABM("Y")]""
Begin DoDot:1
+17 SET ABM("Y0")=$PIECE(^DD(9002274.3013,.03,0),U,3)
+18 SET ABM("Y0")=$PIECE($PIECE(ABM("Y0"),ABM("Y")_":",2),";",1)
End DoDot:1
+19 WRITE !,"[",ABM("I"),"]"
+20 IF +$PIECE(ABMV("X1"),U)=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$PIECE(ABMZ(ABM("I")),U,3),0)),U)
IF ($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$PIECE(ABMZ(ABM("I")),U,3),0)),U,11)'="")
Begin DoDot:1
+21 WRITE ?4,"*"
+22 WRITE $PIECE($GET(^AUTNINS($PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),13,$PIECE(ABMZ(ABM("I")),U,3),0)),U,11),0)),U)
End DoDot:1
+23 IF '$TEST
WRITE ?5,$PIECE(ABMZ(ABM("I")),U)
+24 WRITE ?37,ABM("Y0")
+25 WRITE ?49,$PIECE($PIECE(ABMV("X2"),U),";",2)
+26 IF ABM("Y")="I"
SET ABM("E")=0
FOR
SET ABM("E")=$ORDER(ABME(ABM("E")))
IF 'ABM("E")
QUIT
SET ABMG(ABM("E"))=ABME(ABM("E"))
+27 ;S ABM("PRI")=$S($P($G(^AUTNINS(ABM("X"),2)),U)="D":4,"MR"[$P($G(^(2)),U):3,$P($G(^(2)),U)="H":2,1:1) ;abm*2.6*10 HEAT73780
+28 ;abm*2.6*10 HEAT73780
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM("X"),".211","I"),1,"I")
+29 ;abm*2.6*10 HEAT73780
SET ABM("PRI")=$SELECT(ABMITYP="D":4,"MR"[ABMITYP:3,ABMITYP="H":2,1:1)
+30 SET ABM(ABM("PRI"))=""
+31 QUIT
+32 ;
D1 ;EP - Delete Insurer Multiple on claim
+1 IF +$EXTRACT(Y,2,3)>0&(+$EXTRACT(Y,2,3)<(ABMZ("NUM")+1))
SET Y=+$EXTRACT(Y,2,3)
GOTO D2
+2 IF ABMZ("NUM")=1
SET Y=1
GOTO D2
+3 IF ABMZ("NUM")<1
Begin DoDot:1
+4 WRITE !,"There is no ",ABMZ("ITEM")," to delete."
+5 HANG 3
End DoDot:1
GOTO DXIT
+6 KILL DIR
SET DIR(0)="NO^1:"_ABMZ("NUM")_":0"
+7 SET DIR("?")="Enter the Sequence Number of "_ABMZ("ITEM")_" to Delete"
+8 SET DIR("A")="Sequence Number to DELETE"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(Y'>0)
GOTO DXIT
D2 IF ABMZ("NUM")=1
WRITE !,"Cannot delete only insurer on claim!"
HANG 1
QUIT
+1 WRITE !
SET ABMX("ANS")=+Y
KILL DIR
SET DIR(0)="YO"
+2 IF $PIECE(ABMZ(ABMX("ANS")),U,4)="I"
WRITE !,"Cannot delete active insurer!"
HANG 1
QUIT
+3 SET DIR("A")="Do you wish "_$PIECE(ABMZ(ABMX("ANS")),U,1)_" DELETED"
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
D3 IF Y=1
Begin DoDot:1
+1 SET DA(1)=ABMP("CDFN")
+2 SET DA=$PIECE(ABMZ(ABMX("ANS")),U,3)
+3 SET DIK="^ABMDCLM(DUZ(2),"_DA(1)_","_ABMZ("SUB")_","
+4 DO ^DIK
End DoDot:1
DXIT KILL ABMX
+1 QUIT
XIT KILL ABM,ABMG
+1 QUIT
