ABMDE ; IHS/ASDST/DMJ - Claim Editor Selection ;
;;2.6;IHS Third Party Billing;**1,3,6,8,9,10,13,14**;NOV 12, 2009;Build 238
;
; IHS/ASDS/LSL - 08/13/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
; Only check eligibility once.
;
; IHS/ASDS/LSL - 08/10/2001 - V2.4 Patch 9 - NOIS OVA-0801-190038
; Unlock the claim file as the lock table is filling up.
;
; IHS/SD/SDR - v2.5 p8 - task 6
; Added code for new page selection (page 3A and page 8K)
;
; IHS/SD/SDR - v2.5 p10 - IM20337
; Added code for Next if ADA and page 9F
;
; IHS/SD/SDR - v2.5 p12 - UFMS
; If user isn't logged into cashiering session they can't do
; this option
;
; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added check for page9
; IHS/SD/SDR - abm*2.6*3 - HEAT10547 - modified page9 check to display 9F & 9G for
; all export modes; all others only for UB or 837I
; IHS/SD/SDR - abm*2.6*6 - 5010 - added changes for page3B
; IHS/SD/SDR - abm*2.6*6 - NOHEAT - fix for <NOLINE>SCRN+2^ABMDE
;IHS/SD/SDR - 2.6*13 - made HCFA go to page 9A instead of straight to 9E
;IHS/SD/SDR - 2.6*14 - HEAT165301 - took out changes for 9A that were included in p13
;
; *********************************************************************
;
I $P($G(^ABMDPARM(DUZ(2),1,0)),U,15)'="Y" D G XIT
.W !!?5,*7,"ACCESS to the CLAIM EDITOR is DENIED until SITE PARAMETERS file",!?5,"has been Reviewed!"
.S DIR(0)="E"
.D ^DIR
.K DIR
K ABMPP,ABMP("PAYM"),DIC
S ABMPERM("EDITOR")=1
;
CLM2 ;EP - CLM2 ENTRY POINT
G XIT:$G(ABMP("PAYM"))!$D(ABMPP("CLM"))
K ABM,ABMP,ABMX,ABMV,ABMZ,ABMC,ABMU,ABML,DIROUT,DIRUT,DIR,DTOUT,DUOUT
W !
D ^ABMDEDIC
G XIT:$D(DIROUT)!$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!'+$G(ABMP("CDFN"))
K ABMP("MULT")
K ABMLOC
;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
;
EXT ;EP - Entry Point used when Adding New Claim
L +^ABMDCLM(DUZ(2),ABMP("CDFN")):0 I $T G CHK
W !!,"Claim # ",ABMP("CDFN")
W *7," - Another User is Editing this Record, try Later!",!
S DIR(0)="E"
D ^DIR
K DIR
Q:$D(ABMPP("STATUS"))
G CLM2
;
CHK ;
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="C" D G CLM2
. W *7,!!!?5,"**** All billing has been completed for Claim: "
. W ABMP("CDFN")," ****"
. W !?10,"The claim is thus closed and uneditable.",!!
. L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
;
DFN ;
S ABMP("PDFN")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1)
S ABMP("VTYP")=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
S DR=".1////"_DT
I $P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="F" S DR=".04////E;"_DR
D ^DIE
K DR
;
CNT ;
S ABMP("SCRN")=0
S ABMP("RTN")="^ABMDE0"
D ^ABMDEVAR
;
SCRN ;EP - Entry Point for Detailed Claim Display
S ABMP("LABEL")=""
D @ABMP("RTN")
I ($D(ABMP("CHK"))!$D(ABMP("DDL")))&($D(DUOUT)!$D(DIROUT)!$D(DTOUT)) D Q
.L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
I $D(DTOUT)!$D(DIROUT)!$D(ABMP("QUIT")) D G XIT
.L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
I $D(DIRUT)!$D(DUOUT)!$D(ABMP("OVER")) D G CLM2
.L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
I $D(Y),Y="Q" L -^ABMDCLM(DUZ(2),ABMP("CDFN")) G CLM2
I $G(ABMNOELG) L -^ABMDCLM(DUZ(2),ABMP("CDFN")) G CLM2 ; ABMNOELG set in ABMDE0
I '$D(ABMP("PAGE")) D PAGE^ABMDEVAR
I $E(Y)="J",($E(Y,2)>0&($E(Y,2)<10))!($E(Y,2)=0),ABMP("PAGE")[$E(Y,2) D JUMP^ABMDEPG G RTN
I "BN"'[Y D SCRN^ABMDEPG:Y="J" G XIT:$D(DIROUT),SCRN:$D(DIRUT) W:+Y=0&(Y'=0) *7 G SCRN:+Y=0&(Y'=0) S ABMP("SCRN")=Y G RTN
I Y="B" D G RTN
.S ABMTEMP=$G(ABMP("PAGE"))_","
.S ABMTEMP=$P(ABMTEMP,(","_ABMP("SCRN")_","))
.S ABMP("SCRN")=$P(ABMTEMP,",",$L(ABMTEMP,","))
.K ABMTEMP
S ABMTEMP=$P(ABMP("PAGE"),ABMP("SCRN")_",",2)
S ABMP("SCRN")=$P(ABMTEMP,",")
K ABMTEMP
;
RTN ;
S:ABMP("SCRN")="3A" ABMP("SCRN")="31"
S:ABMP("SCRN")="3B" ABMP("SCRN")="32" ;abm*2.6*6 5010
S:ABMP("SCRN")[5 ABMP("SCRN")=5 ;abm*2.6*8
;I ABMP("SCRN")["9" S ABP("SCRN")="9" ;abm*2.6*1 HEAT6439 ;abm*2.6*6
I ABMP("SCRN")["9" S ABMP("SCRN")="9" ;abm*2.6*1 HEAT6439 ;abm*2.6*6
;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["837 P",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT6" ;abm*2.6*3 HEAT10547 ;abm*2.6*10 HEAT68575
I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["HCFA",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT5" ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 but back in
;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["HCFA",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT" ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 NOHEAT3
;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["CMS",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT" ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 NOHEAT3 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 took out
;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT6" ;abm*2.6*8
S:+ABMP("SCRN")=0 ABMP("SCRN")=0
S ABMP("RTN")=ABMP("LABEL")_"^ABMDE"_ABMP("SCRN")
I '$G(ABMPERM("EDITOR")),($G(ABMP("SCRN"))="") G XIT
G SCRN
;
XIT ;EXIT POINT
I $D(ABMPP("STATUS")) S ABMPP("STATUS")=$S($D(ABMP("OVER")):0,$D(DUOUT)!($G(Y)="Q"):1,1:2)
I '$D(ABMC("DDL")) K ABMP,ABM,ABMV,ABME,ABMX,ABML,ABMZ,ABMC,ABMU
K ABMPERM("EDITOR")
I $D(ABMP("CDFN")) L -^ABMDCLM(DUZ(2),ABMP("CDFN"))
Q
ABMDE ; IHS/ASDST/DMJ - Claim Editor Selection ;
+1 ;;2.6;IHS Third Party Billing;**1,3,6,8,9,10,13,14**;NOV 12, 2009;Build 238
+2 ;
+3 ; IHS/ASDS/LSL - 08/13/2001 - V2.4 Patch 9 - NOIS HQW-0798-100082
+4 ; Only check eligibility once.
+5 ;
+6 ; IHS/ASDS/LSL - 08/10/2001 - V2.4 Patch 9 - NOIS OVA-0801-190038
+7 ; Unlock the claim file as the lock table is filling up.
+8 ;
+9 ; IHS/SD/SDR - v2.5 p8 - task 6
+10 ; Added code for new page selection (page 3A and page 8K)
+11 ;
+12 ; IHS/SD/SDR - v2.5 p10 - IM20337
+13 ; Added code for Next if ADA and page 9F
+14 ;
+15 ; IHS/SD/SDR - v2.5 p12 - UFMS
+16 ; If user isn't logged into cashiering session they can't do
+17 ; this option
+18 ;
+19 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added check for page9
+20 ; IHS/SD/SDR - abm*2.6*3 - HEAT10547 - modified page9 check to display 9F & 9G for
+21 ; all export modes; all others only for UB or 837I
+22 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added changes for page3B
+23 ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - fix for <NOLINE>SCRN+2^ABMDE
+24 ;IHS/SD/SDR - 2.6*13 - made HCFA go to page 9A instead of straight to 9E
+25 ;IHS/SD/SDR - 2.6*14 - HEAT165301 - took out changes for 9A that were included in p13
+26 ;
+27 ; *********************************************************************
+28 ;
+29 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,0)),U,15)'="Y"
Begin DoDot:1
+30 WRITE !!?5,*7,"ACCESS to the CLAIM EDITOR is DENIED until SITE PARAMETERS file",!?5,"has been Reviewed!"
+31 SET DIR(0)="E"
+32 DO ^DIR
+33 KILL DIR
End DoDot:1
GOTO XIT
+34 KILL ABMPP,ABMP("PAYM"),DIC
+35 SET ABMPERM("EDITOR")=1
+36 ;
CLM2 ;EP - CLM2 ENTRY POINT
+1 IF $GET(ABMP("PAYM"))!$DATA(ABMPP("CLM"))
GOTO XIT
+2 KILL ABM,ABMP,ABMX,ABMV,ABMZ,ABMC,ABMU,ABML,DIROUT,DIRUT,DIR,DTOUT,DUOUT
+3 WRITE !
+4 DO ^ABMDEDIC
+5 IF $DATA(DIROUT)!$DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!'+$GET(ABMP("CDFN"))
GOTO XIT
+6 KILL ABMP("MULT")
+7 KILL ABMLOC
+8 ;start new code abm*2.6*9 NOHEAT - ensure UFMS is setup
+9 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=""
Begin DoDot:1
+10 WRITE !!,"* * UFMS SETUP MUST BE DONE BEFORE ANY BILLING FUNCTIONS CAN BE USED! * *",!
+11 SET DIR(0)="E"
SET DIR("A")="Enter RETURN to Continue"
DO ^DIR
KILL DIR
End DoDot:1
QUIT
+12 ;end new code
+13 IF $PIECE($GET(^ABMDPARM(DUZ(2),1,4)),U,15)=1
Begin DoDot:1
+14 SET ABMUOPNS=$$FINDOPEN^ABMUCUTL(DUZ)
+15 IF +$GET(ABMUOPNS)=0
Begin DoDot:2
+16 WRITE !!,"* * YOU MUST SIGN IN TO BE ABLE TO PERFORM BILLING FUNCTIONS! * *",!
+17 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
+18 ;
EXT ;EP - Entry Point used when Adding New Claim
+1 LOCK +^ABMDCLM(DUZ(2),ABMP("CDFN")):0
IF $TEST
GOTO CHK
+2 WRITE !!,"Claim # ",ABMP("CDFN")
+3 WRITE *7," - Another User is Editing this Record, try Later!",!
+4 SET DIR(0)="E"
+5 DO ^DIR
+6 KILL DIR
+7 IF $DATA(ABMPP("STATUS"))
QUIT
+8 GOTO CLM2
+9 ;
CHK ;
+1 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="C"
Begin DoDot:1
+2 WRITE *7,!!!?5,"**** All billing has been completed for Claim: "
+3 WRITE ABMP("CDFN")," ****"
+4 WRITE !?10,"The claim is thus closed and uneditable.",!!
+5 LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
End DoDot:1
GOTO CLM2
+6 ;
DFN ;
+1 SET ABMP("PDFN")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,1)
+2 SET ABMP("VTYP")=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,7)
+3 SET DIE="^ABMDCLM(DUZ(2),"
+4 SET DA=ABMP("CDFN")
+5 SET DR=".1////"_DT
+6 IF $PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,4)="F"
SET DR=".04////E;"_DR
+7 DO ^DIE
+8 KILL DR
+9 ;
CNT ;
+1 SET ABMP("SCRN")=0
+2 SET ABMP("RTN")="^ABMDE0"
+3 DO ^ABMDEVAR
+4 ;
SCRN ;EP - Entry Point for Detailed Claim Display
+1 SET ABMP("LABEL")=""
+2 DO @ABMP("RTN")
+3 IF ($DATA(ABMP("CHK"))!$DATA(ABMP("DDL")))&($DATA(DUOUT)!$DATA(DIROUT)!$DATA(DTOUT))
Begin DoDot:1
+4 LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
End DoDot:1
QUIT
+5 IF $DATA(DTOUT)!$DATA(DIROUT)!$DATA(ABMP("QUIT"))
Begin DoDot:1
+6 LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
End DoDot:1
GOTO XIT
+7 IF $DATA(DIRUT)!$DATA(DUOUT)!$DATA(ABMP("OVER"))
Begin DoDot:1
+8 LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
End DoDot:1
GOTO CLM2
+9 IF $DATA(Y)
IF Y="Q"
LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
GOTO CLM2
+10 ; ABMNOELG set in ABMDE0
IF $GET(ABMNOELG)
LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
GOTO CLM2
+11 IF '$DATA(ABMP("PAGE"))
DO PAGE^ABMDEVAR
+12 IF $EXTRACT(Y)="J"
IF ($EXTRACT(Y,2)>0&($EXTRACT(Y,2)<10))!($EXTRACT(Y,2)=0)
IF ABMP("PAGE")[$EXTRACT(Y,2)
DO JUMP^ABMDEPG
GOTO RTN
+13 IF "BN"'[Y
IF Y="J"
DO SCRN^ABMDEPG
IF $DATA(DIROUT)
GOTO XIT
IF $DATA(DIRUT)
GOTO SCRN
IF +Y=0&(Y'=0)
WRITE *7
IF +Y=0&(Y'=0)
GOTO SCRN
SET ABMP("SCRN")=Y
GOTO RTN
+14 IF Y="B"
Begin DoDot:1
+15 SET ABMTEMP=$GET(ABMP("PAGE"))_","
+16 SET ABMTEMP=$PIECE(ABMTEMP,(","_ABMP("SCRN")_","))
+17 SET ABMP("SCRN")=$PIECE(ABMTEMP,",",$LENGTH(ABMTEMP,","))
+18 KILL ABMTEMP
End DoDot:1
GOTO RTN
+19 SET ABMTEMP=$PIECE(ABMP("PAGE"),ABMP("SCRN")_",",2)
+20 SET ABMP("SCRN")=$PIECE(ABMTEMP,",")
+21 KILL ABMTEMP
+22 ;
RTN ;
+1 IF ABMP("SCRN")="3A"
SET ABMP("SCRN")="31"
+2 ;abm*2.6*6 5010
IF ABMP("SCRN")="3B"
SET ABMP("SCRN")="32"
+3 ;abm*2.6*8
IF ABMP("SCRN")[5
SET ABMP("SCRN")=5
+4 ;I ABMP("SCRN")["9" S ABP("SCRN")="9" ;abm*2.6*1 HEAT6439 ;abm*2.6*6
+5 ;abm*2.6*1 HEAT6439 ;abm*2.6*6
IF ABMP("SCRN")["9"
SET ABMP("SCRN")="9"
+6 ;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["837 P",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT6" ;abm*2.6*3 HEAT10547 ;abm*2.6*10 HEAT68575
+7 ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 but back in
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)["HCFA"
IF (+ABMP("SCRN")["9")
SET ABMP("LABEL")="OPT5"
+8 ;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["HCFA",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT" ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 NOHEAT3
+9 ;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["CMS",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT" ;abm*2.6*10 HEAT68575 ;abm*2.6*13 exp mode 35 ;abm*2.6*14 NOHEAT3 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 took out
+10 ;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA",(+ABMP("SCRN")["9") S ABMP("LABEL")="OPT6" ;abm*2.6*8
+11 IF +ABMP("SCRN")=0
SET ABMP("SCRN")=0
+12 SET ABMP("RTN")=ABMP("LABEL")_"^ABMDE"_ABMP("SCRN")
+13 IF '$GET(ABMPERM("EDITOR"))
IF ($GET(ABMP("SCRN"))="")
GOTO XIT
+14 GOTO SCRN
+15 ;
XIT ;EXIT POINT
+1 IF $DATA(ABMPP("STATUS"))
SET ABMPP("STATUS")=$SELECT($DATA(ABMP("OVER")):0,$DATA(DUOUT)!($GET(Y)="Q"):1,1:2)
+2 IF '$DATA(ABMC("DDL"))
KILL ABMP,ABM,ABMV,ABME,ABMX,ABML,ABMZ,ABMC,ABMU
+3 KILL ABMPERM("EDITOR")
+4 IF $DATA(ABMP("CDFN"))
LOCK -^ABMDCLM(DUZ(2),ABMP("CDFN"))
+5 QUIT
