ABMDEADD ; IHS/ASDST/DMJ - Add New Claim - Non PCC Option ;
;;2.6;IHS 3P BILLING SYSTEM;**9**;NOV 12, 2009
;
; IHS/SD/SDR - v2.5 p3 - 2/28/03 - QEA-0702-130030
; Added code for manually entered insurer check
; IHS/SD/SDR - v2.5 p9 - IM15913
; Add check for admit/encounter date to be >DOB
; IHS/SD/SDR - v2.5 p12 - UFMS
; If user isn't logged into cashiering session they can't do
; this option
;
S U="^" W !
PAT K ABMP,ABM
;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
K DIC S DIC="^AUPNPAT(",DIC(0)="QZEAM"
S DIC("A")="Select PATIENT NAME....: "
D ^DIC
I $G(X)=""!$D(DUOUT)!$D(DTOUT) G XIT
I +Y<1 W *7 G XIT
S ABMP("PDFN")=+Y
;
LOC S ABMP("LDFN")=DUZ(2)
;
CLN K DIC S DIC(0)="QEAM",DIC="^DIC(40.7,"
S DIC("A")="Select CLINIC..........: ",DIC("B")="GENERAL"
D ^DIC
I $D(DUOUT)!$D(DTOUT)!$D(DIROUT) G XIT
I X="" W *7 G CLN
S ABMP("CLN")=+Y
;
VTYP K DIC S DIC(0)="QEAM",DIC="^ABMDVTYP(",DIC("B")="OUTPATIENT"
S DIC("A")="Select VISIT TYPE......: "
S DIC("S")="I Y'=121"
D ^DIC K DIC
I X="" W *7 G VTYP
G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
S ABMP("VTYP")=+Y
;
EDT ;
K DIR S DIR(0)="D^"_$P($G(^DPT(ABMP("PDFN"),0)),U,3)_":DT:EX"
S DIR("A")=$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):"Enter ADMISSION DATE...:",1:"Enter ENCOUNTER DATE...:")
D ^DIR
G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
S ABMP("VDT")=+Y
S:ABMP("VTYP")'=111 ABMP("DDT")=+Y
;
CHK ;
S ABM="" F S ABM=$O(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM)) Q:'ABM D
.Q:$P($G(^ABMDCLM(DUZ(2),ABM,0)),U,2)'=ABMP("VDT")
.S ABM(ABM)=""
.Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,7)'=ABMP("VTYP")
.I ABMP("VTYP")=111 S ABMDUP=1 Q
.Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,3)'=ABMP("LDFN")
.Q:$P(^ABMDCLM(DUZ(2),ABM,0),U,6)'=ABMP("CLN")
.S ABMDUP=1
I $G(ABMDUP) G DUP
I '+$O(ABM(0)) G DDT
W !!,"The following Claims already exist for this Patient on this date:"
W !!,"Claim",?8,"Location",?40,"Clinic",?62,"Visit Type",!,"-------------------------------------------------------------------------------"
S ABM=0 F S ABM=$O(ABM(ABM)) Q:'ABM D
.Q:'$D(^ABMDCLM(DUZ(2),ABM,0))
.W !,ABM,?8,$E($P(^DIC(4,$P(^ABMDCLM(DUZ(2),ABM,0),U,3),0),U),1,30)
.W ?40,$E($P(^DIC(40.7,$P(^ABMDCLM(DUZ(2),ABM,0),U,6),0),U),1,20)
.W ?62,$E($P(^ABMDVTYP($P(^ABMDCLM(DUZ(2),ABM,0),U,7),0),U),1,17)
W ! K DIR S DIR(0)="Y",DIR("A")="Do you wish to CONTINUE to ADD this Claim" D ^DIR K DIR G XIT:'Y
;
DDT I ABMP("VTYP")=111 D G XIT:$D(DTOUT)!$D(DIROUT)!$D(DUOUT)
.K DIR S DIR(0)="DA^"_ABMP("VDT")_":DT:EX"
.S DIR("A")="Enter DISCHARGE DATE...: "
.D ^DIR
.S ABMP("DDT")=+Y
;
LCHK ;CHECK ELIGIBILITY
W !!,"Checking eligibility..."
S ABMVDFN=$G(ABMP("VDFN")),ABMPDFN=ABMP("PDFN"),ABMVDT=ABMP("VDT")
D ELG^ABMDLCK(ABMVDFN,.ABML,ABMPDFN,ABMVDT)
TST ;
I '$D(ABML)!($O(ABML(""))>96) D
.W !!,*7,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
.W " Patient either has no 3rd Party Resources for the date of the visit or the",!,"location/clinic is not billable for the insuring source.",!
.K DIR S DIR(0)="Y",DIR("A")="Continue",DIR("B")="NO" D ^DIR K DIR I Y'=1 S ABM("F1")=1 Q
.S DIC="^AUTNINS(",DIC(0)="AEMQ",DIC("S")="I $P($G(^(1)),""^"",7)=1",DIC("A")="Select INSURER to Bill // " D ^DIC K DIC I Y<0 S ABM("F1")=1 Q
.S ABM("TYP")=$P($G(^AUTNINS(+Y,2)),U) I ABM("TYP")="" S ABM("F1")=1 W !!,"Insurance type undefined for this insurer.",! Q
.S ABML(1,+Y)="^^"_ABM("TYP")_"^^^^M"
.S ABM("F1")=0
G:'$G(ABM("F1")) ^ABMDEAD2
;
W !!,*7,"Claim ",$$EN^ABMVDF("RVN"),"NOT",$$EN^ABMVDF("RVF")," created.",! H 3
XIT K DIC,ABM,ABMP,ABMX,ABMV,ABME,ABML,AUPNLK("ALL"),ABMDUP
Q
;
DUP W *7,!!,"Claim Number: ",ABM," already exists with the Identifiers entered above!",!?5,"(NOTE: Use the EDIT CLAIM Option to Access Existing Claims)"
K DIR S DIR(0)="E" D ^DIR K DIR
G XIT
ABMDEADD ; IHS/ASDST/DMJ - Add New Claim - Non PCC Option ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**9**;NOV 12, 2009
+2 ;
+3 ; IHS/SD/SDR - v2.5 p3 - 2/28/03 - QEA-0702-130030
+4 ; Added code for manually entered insurer check
+5 ; IHS/SD/SDR - v2.5 p9 - IM15913
+6 ; Add check for admit/encounter date to be >DOB
+7 ; IHS/SD/SDR - v2.5 p12 - UFMS
+8 ; If user isn't logged into cashiering session they can't do
+9 ; this option
+10 ;
+11 SET U="^"
WRITE !
PAT KILL ABMP,ABM
+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 KILL DIC
SET DIC="^AUPNPAT("
SET DIC(0)="QZEAM"
+12 SET DIC("A")="Select PATIENT NAME....: "
+13 DO ^DIC
+14 IF $GET(X)=""!$DATA(DUOUT)!$DATA(DTOUT)
GOTO XIT
+15 IF +Y<1
WRITE *7
GOTO XIT
+16 SET ABMP("PDFN")=+Y
+17 ;
LOC SET ABMP("LDFN")=DUZ(2)
+1 ;
CLN KILL DIC
SET DIC(0)="QEAM"
SET DIC="^DIC(40.7,"
+1 SET DIC("A")="Select CLINIC..........: "
SET DIC("B")="GENERAL"
+2 DO ^DIC
+3 IF $DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
GOTO XIT
+4 IF X=""
WRITE *7
GOTO CLN
+5 SET ABMP("CLN")=+Y
+6 ;
VTYP KILL DIC
SET DIC(0)="QEAM"
SET DIC="^ABMDVTYP("
SET DIC("B")="OUTPATIENT"
+1 SET DIC("A")="Select VISIT TYPE......: "
+2 SET DIC("S")="I Y'=121"
+3 DO ^DIC
KILL DIC
+4 IF X=""
WRITE *7
GOTO VTYP
+5 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
GOTO XIT
+6 SET ABMP("VTYP")=+Y
+7 ;
EDT ;
+1 KILL DIR
SET DIR(0)="D^"_$PIECE($GET(^DPT(ABMP("PDFN"),0)),U,3)_":DT:EX"
+2 SET DIR("A")=$SELECT(ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111):"Enter ADMISSION DATE...:",1:"Enter ENCOUNTER DATE...:")
+3 DO ^DIR
+4 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
GOTO XIT
+5 SET ABMP("VDT")=+Y
+6 IF ABMP("VTYP")'=111
SET ABMP("DDT")=+Y
+7 ;
CHK ;
+1 SET ABM=""
FOR
SET ABM=$ORDER(^ABMDCLM(DUZ(2),"B",ABMP("PDFN"),ABM))
IF 'ABM
QUIT
Begin DoDot:1
+2 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABM,0)),U,2)'=ABMP("VDT")
QUIT
+3 SET ABM(ABM)=""
+4 IF $PIECE(^ABMDCLM(DUZ(2),ABM,0),U,7)'=ABMP("VTYP")
QUIT
+5 IF ABMP("VTYP")=111
SET ABMDUP=1
QUIT
+6 IF $PIECE(^ABMDCLM(DUZ(2),ABM,0),U,3)'=ABMP("LDFN")
QUIT
+7 IF $PIECE(^ABMDCLM(DUZ(2),ABM,0),U,6)'=ABMP("CLN")
QUIT
+8 SET ABMDUP=1
End DoDot:1
+9 IF $GET(ABMDUP)
GOTO DUP
+10 IF '+$ORDER(ABM(0))
GOTO DDT
+11 WRITE !!,"The following Claims already exist for this Patient on this date:"
+12 WRITE !!,"Claim",?8,"Location",?40,"Clinic",?62,"Visit Type",!,"-------------------------------------------------------------------------------"
+13 SET ABM=0
FOR
SET ABM=$ORDER(ABM(ABM))
IF 'ABM
QUIT
Begin DoDot:1
+14 IF '$DATA(^ABMDCLM(DUZ(2),ABM,0))
QUIT
+15 WRITE !,ABM,?8,$EXTRACT($PIECE(^DIC(4,$PIECE(^ABMDCLM(DUZ(2),ABM,0),U,3),0),U),1,30)
+16 WRITE ?40,$EXTRACT($PIECE(^DIC(40.7,$PIECE(^ABMDCLM(DUZ(2),ABM,0),U,6),0),U),1,20)
+17 WRITE ?62,$EXTRACT($PIECE(^ABMDVTYP($PIECE(^ABMDCLM(DUZ(2),ABM,0),U,7),0),U),1,17)
End DoDot:1
+18 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Do you wish to CONTINUE to ADD this Claim"
DO ^DIR
KILL DIR
IF 'Y
GOTO XIT
+19 ;
DDT IF ABMP("VTYP")=111
Begin DoDot:1
+1 KILL DIR
SET DIR(0)="DA^"_ABMP("VDT")_":DT:EX"
+2 SET DIR("A")="Enter DISCHARGE DATE...: "
+3 DO ^DIR
+4 SET ABMP("DDT")=+Y
End DoDot:1
IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(DUOUT)
GOTO XIT
+5 ;
LCHK ;CHECK ELIGIBILITY
+1 WRITE !!,"Checking eligibility..."
+2 SET ABMVDFN=$GET(ABMP("VDFN"))
SET ABMPDFN=ABMP("PDFN")
SET ABMVDT=ABMP("VDT")
+3 DO ELG^ABMDLCK(ABMVDFN,.ABML,ABMPDFN,ABMVDT)
TST ;
+1 IF '$DATA(ABML)!($ORDER(ABML(""))>96)
Begin DoDot:1
+2 WRITE !!,*7,$$EN^ABMVDF("RVN"),"NOTE:",$$EN^ABMVDF("RVF")
+3 WRITE " Patient either has no 3rd Party Resources for the date of the visit or the",!,"location/clinic is not billable for the insuring source.",!
+4 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Continue"
SET DIR("B")="NO"
DO ^DIR
KILL DIR
IF Y'=1
SET ABM("F1")=1
QUIT
+5 SET DIC="^AUTNINS("
SET DIC(0)="AEMQ"
SET DIC("S")="I $P($G(^(1)),""^"",7)=1"
SET DIC("A")="Select INSURER to Bill // "
DO ^DIC
KILL DIC
IF Y<0
SET ABM("F1")=1
QUIT
+6 SET ABM("TYP")=$PIECE($GET(^AUTNINS(+Y,2)),U)
IF ABM("TYP")=""
SET ABM("F1")=1
WRITE !!,"Insurance type undefined for this insurer.",!
QUIT
+7 SET ABML(1,+Y)="^^"_ABM("TYP")_"^^^^M"
+8 SET ABM("F1")=0
End DoDot:1
+9 IF '$GET(ABM("F1"))
GOTO ^ABMDEAD2
+10 ;
+11 WRITE !!,*7,"Claim ",$$EN^ABMVDF("RVN"),"NOT",$$EN^ABMVDF("RVF")," created.",!
HANG 3
XIT KILL DIC,ABM,ABMP,ABMX,ABMV,ABME,ABML,AUPNLK("ALL"),ABMDUP
+1 QUIT
+2 ;
DUP WRITE *7,!!,"Claim Number: ",ABM," already exists with the Identifiers entered above!",!?5,"(NOTE: Use the EDIT CLAIM Option to Access Existing Claims)"
+1 KILL DIR
SET DIR(0)="E"
DO ^DIR
KILL DIR
+2 GOTO XIT
