ABMDE.m

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