ABMDEPG ; IHS/ASDST/DMJ - EDIT PAGE SELECTION ;
;;2.6;IHS Third Party Billing;**1,6,8,14**;NOV 12, 2009;Build 238
;
;IHS/DSD/MRS - 8/19/1999 - NOIS QBA-0299-130064 Patch 3 #10
; Modified jump variable to remove illegal spaces.A space is used
; as a delimiter for $piece executable
;
; IHS/SD/SDR - v2.5 p8 - task 6
; Added code for pages 8K and 3A (ambulance billing)
;
; IHS/SD/SDR - v2.5 p10 - IM20337 - Fixed jumping for page 9F if ADA
; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added jump to page9G
; IHS/SD/SDR - abm*2.6*6 - 5010 - added page3B
; IHS/SD/SDR - abm*2.6*6 - NOHEAT - fix for jumping to 8-pages
;IHS/SD/SDR - 2.6*14 - HEAT163711 - Made change for exp mode 35 to allow jumping to page 9A and 9G.
;IHS/SD/SDR - 2.6*14 - HEAT165301,CR3165 - Removed page 9A jumping that was added because it was causing more issues.
;
SCRN ;EP for Edit Screen Controller
W !!
K %P,DIR S DIR(0)="FO^0:10"
S DIR("A")="Desired SCREEN ("
S DIR("?",1)=" Choose One of the Following Screens:"
S DIR("?",2)=" "
F ABMO("CTR")=1:1 S ABMO("TXT")=$P(ABMP("PAGE"),",",ABMO("CTR")) Q:ABMO("TXT")="" D
.S DIR("?",ABMO("CTR"))=$P($T(@ABMO("TXT")),";;",2)
.S DIR("A")=DIR("A")_$P($T(@ABMO("TXT")),";;",3)_"/"
S DIR("?",ABMO("CTR"))=" "
S DIR("?")=" Enter the Number of the Desired Screen."
S DIR("A")=$P(DIR("A"),"/",1,$L(DIR("A"),"/")-1)_")"
D ^DIR K DIR
S ABMO("OPT")=","_ABMP("PAGE")_",",ABMO("X")=","_X_"," G:ABMO("OPT")[ABMO("X")!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) XIT
A3 I X="3A",ABMP("PAGE")["31" S ABMP("LABEL")="OPT" G XIT
B3 I X="3B",ABMP("PAGE")["32" S ABMP("LABEL")="OPT" G XIT ;abm*2.6*6 5010
A5 I X="5A",ABMP("PAGE")["5" S ABMP("LABEL")="OPT" G XIT
B5 I X="5B",ABMP("PAGE")["5" S ABMP("LABEL")="OPT2" G XIT
A9 I X="9A",ABMP("PAGE")["9" S ABMP("LABEL")="OPT" G XIT
B9 I X="9B",ABMP("PAGE")["9" S ABMP("LABEL")="OPT2" G XIT
C9 I X="9C",ABMP("PAGE")["9" S ABMP("LABEL")="OPT3" G XIT
D9 I X="9D",ABMP("PAGE")["9" S ABMP("LABEL")="OPT4" G XIT
E9 I X="9E",ABMP("PAGE")["9" S ABMP("LABEL")="OPT5" G XIT
F9 I X="9F",ABMP("PAGE")["9" S ABMP("LABEL")="OPT6" G XIT
G9 I X="9G",ABMP("PAGE")["9" S ABMP("LABEL")="OPT7" G XIT ;abm*2.6*1 HEAT6439
A8 I X="8A",ABMP("PAGE")["8" S ABMP("LABEL")="A" G XIT
B8 I X="8B",ABMP("PAGE")["8" S ABMP("LABEL")="B" G XIT
C8 I X="8C",ABMP("PAGE")["8" S ABMP("LABEL")="C" G XIT
D8 I X="8D",ABMP("PAGE")["8" S ABMP("LABEL")="D" G XIT
E8 I X="8E",ABMP("PAGE")["8" S ABMP("LABEL")="E" G XIT
F8 I X="8F",ABMP("PAGE")["8" S ABMP("LABEL")="F" G XIT
G8 I X="8G",ABMP("PAGE")["8" S ABMP("LABEL")="G" G XIT
H8 I X="8H",ABMP("PAGE")["8" S ABMP("LABEL")="H" G XIT
I8 I X="8I",ABMP("PAGE")["8" S ABMP("LABEL")="I" G XIT
J8 I X="8J",ABMP("PAGE")["8" S ABMP("LABEL")="J" G XIT
K8 I X="8K",ABMP("PAGE")["8" S ABMP("LABEL")="K" G XIT
W *7 G SCRN
;
0 ;; 0 - Claim Summary;;0
1 ;; 1 - Claim Identifiers;;1
2 ;; 2 - Billing Entities;;2
3 ;; 3 - Questions;;3
4 ;; 4 - Provider Data;;4
5 ;; 5 - ICD Diagnosis/Procedures;;5
6 ;; 6 - Dental;;6
7 ;; 7 - Inpatient Data;;7
8 ;; 8 - Worksheet Data (CPT);;8
9 ;; 9 - UB-82 Info (Occurance, Condition, Sp. Prog, Remarks);;9
31 ;; 3A - Ambulance;;3A
;; added below line abm*2.6*6 5010
32 ;; 3B - Third Party Liability/Worker's Comp;;3B
;
XIT K ABMO,ABMP("OPT")
I X["8" S (Y,ABMP("SCRN"))="8" ;abm*2.6*6 NOHEAT
Q
;
JUMP ;EP for Jumping to a Page
S X=$TR(X," ")
S ABM("EX")=$S("ABCDEFGHIJK"[$E(X,3):$E(X,3),1:"")_+$E(X,2)
I $T(@ABM("EX"))]"" D
.S ABMP("SCRN")=$S(X="J3A"&(ABMP("PAGE")[",31,"):"31",1:$E(X,2))
.S ABMP("SCRN")=$S(X="J3B"&(ABMP("PAGE")[",32,"):"32",1:$E(X,2)) ;abm*2.6*6 5010
.S ABM("EX")=$P($T(@ABM("EX")),$E(X,3)_$E(X,2)_" ",2)
.S X=$E(X,2,3)
.;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA",(X'["F"),(X["9") S ABM("EX")=";;",ABMP("SCRN")=0 ;ABM*2.6*8 NOHEAT
.I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA",((X'["F")&(X'["G")),(X["9") S ABM("EX")=";;",ABMP("SCRN")=0 ;ABM*2.6*8 NOHEAT2
.;abm*2.6*14 HEAT165301 - put below line back in; they should see pg but don't force line to page 3 question
.I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["CMS",((X'["A")&(X'["E")*(X'["F")&(X'["G")),(X["9") S ABM("EX")=";;",ABMP("SCRN")=0 ;ABM*2.6*14 HEAT163711 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 removed line to remove 9A displaying
.X ABM("EX")
Q
ABMDEPG ; IHS/ASDST/DMJ - EDIT PAGE SELECTION ;
+1 ;;2.6;IHS Third Party Billing;**1,6,8,14**;NOV 12, 2009;Build 238
+2 ;
+3 ;IHS/DSD/MRS - 8/19/1999 - NOIS QBA-0299-130064 Patch 3 #10
+4 ; Modified jump variable to remove illegal spaces.A space is used
+5 ; as a delimiter for $piece executable
+6 ;
+7 ; IHS/SD/SDR - v2.5 p8 - task 6
+8 ; Added code for pages 8K and 3A (ambulance billing)
+9 ;
+10 ; IHS/SD/SDR - v2.5 p10 - IM20337 - Fixed jumping for page 9F if ADA
+11 ; IHS/SD/SDR - abm*2.6*1 - HEAT6439 - Added jump to page9G
+12 ; IHS/SD/SDR - abm*2.6*6 - 5010 - added page3B
+13 ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - fix for jumping to 8-pages
+14 ;IHS/SD/SDR - 2.6*14 - HEAT163711 - Made change for exp mode 35 to allow jumping to page 9A and 9G.
+15 ;IHS/SD/SDR - 2.6*14 - HEAT165301,CR3165 - Removed page 9A jumping that was added because it was causing more issues.
+16 ;
SCRN ;EP for Edit Screen Controller
+1 WRITE !!
+2 KILL %P,DIR
SET DIR(0)="FO^0:10"
+3 SET DIR("A")="Desired SCREEN ("
+4 SET DIR("?",1)=" Choose One of the Following Screens:"
+5 SET DIR("?",2)=" "
+6 FOR ABMO("CTR")=1:1
SET ABMO("TXT")=$PIECE(ABMP("PAGE"),",",ABMO("CTR"))
IF ABMO("TXT")=""
QUIT
Begin DoDot:1
+7 SET DIR("?",ABMO("CTR"))=$PIECE($TEXT(@ABMO("TXT")),";;",2)
+8 SET DIR("A")=DIR("A")_$PIECE($TEXT(@ABMO("TXT")),";;",3)_"/"
End DoDot:1
+9 SET DIR("?",ABMO("CTR"))=" "
+10 SET DIR("?")=" Enter the Number of the Desired Screen."
+11 SET DIR("A")=$PIECE(DIR("A"),"/",1,$LENGTH(DIR("A"),"/")-1)_")"
+12 DO ^DIR
KILL DIR
+13 SET ABMO("OPT")=","_ABMP("PAGE")_","
SET ABMO("X")=","_X_","
IF ABMO("OPT")[ABMO("X")!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO XIT
A3 IF X="3A"
IF ABMP("PAGE")["31"
SET ABMP("LABEL")="OPT"
GOTO XIT
B3 ;abm*2.6*6 5010
IF X="3B"
IF ABMP("PAGE")["32"
SET ABMP("LABEL")="OPT"
GOTO XIT
A5 IF X="5A"
IF ABMP("PAGE")["5"
SET ABMP("LABEL")="OPT"
GOTO XIT
B5 IF X="5B"
IF ABMP("PAGE")["5"
SET ABMP("LABEL")="OPT2"
GOTO XIT
A9 IF X="9A"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT"
GOTO XIT
B9 IF X="9B"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT2"
GOTO XIT
C9 IF X="9C"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT3"
GOTO XIT
D9 IF X="9D"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT4"
GOTO XIT
E9 IF X="9E"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT5"
GOTO XIT
F9 IF X="9F"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT6"
GOTO XIT
G9 ;abm*2.6*1 HEAT6439
IF X="9G"
IF ABMP("PAGE")["9"
SET ABMP("LABEL")="OPT7"
GOTO XIT
A8 IF X="8A"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="A"
GOTO XIT
B8 IF X="8B"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="B"
GOTO XIT
C8 IF X="8C"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="C"
GOTO XIT
D8 IF X="8D"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="D"
GOTO XIT
E8 IF X="8E"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="E"
GOTO XIT
F8 IF X="8F"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="F"
GOTO XIT
G8 IF X="8G"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="G"
GOTO XIT
H8 IF X="8H"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="H"
GOTO XIT
I8 IF X="8I"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="I"
GOTO XIT
J8 IF X="8J"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="J"
GOTO XIT
K8 IF X="8K"
IF ABMP("PAGE")["8"
SET ABMP("LABEL")="K"
GOTO XIT
+1 WRITE *7
GOTO SCRN
+2 ;
0 ;; 0 - Claim Summary;;0
1 ;; 1 - Claim Identifiers;;1
2 ;; 2 - Billing Entities;;2
3 ;; 3 - Questions;;3
4 ;; 4 - Provider Data;;4
5 ;; 5 - ICD Diagnosis/Procedures;;5
6 ;; 6 - Dental;;6
7 ;; 7 - Inpatient Data;;7
8 ;; 8 - Worksheet Data (CPT);;8
9 ;; 9 - UB-82 Info (Occurance, Condition, Sp. Prog, Remarks);;9
31 ;; 3A - Ambulance;;3A
+1 ;; added below line abm*2.6*6 5010
32 ;; 3B - Third Party Liability/Worker's Comp;;3B
+1 ;
XIT KILL ABMO,ABMP("OPT")
+1 ;abm*2.6*6 NOHEAT
IF X["8"
SET (Y,ABMP("SCRN"))="8"
+2 QUIT
+3 ;
JUMP ;EP for Jumping to a Page
+1 SET X=$TRANSLATE(X," ")
+2 SET ABM("EX")=$SELECT("ABCDEFGHIJK"[$EXTRACT(X,3):$EXTRACT(X,3),1:"")_+$EXTRACT(X,2)
+3 IF $TEXT(@ABM("EX"))]""
Begin DoDot:1
+4 SET ABMP("SCRN")=$SELECT(X="J3A"&(ABMP("PAGE")[",31,"):"31",1:$EXTRACT(X,2))
+5 ;abm*2.6*6 5010
SET ABMP("SCRN")=$SELECT(X="J3B"&(ABMP("PAGE")[",32,"):"32",1:$EXTRACT(X,2))
+6 SET ABM("EX")=$PIECE($TEXT(@ABM("EX")),$EXTRACT(X,3)_$EXTRACT(X,2)_" ",2)
+7 SET X=$EXTRACT(X,2,3)
+8 ;I $P($G(^ABMDEXP(ABMP("EXP"),0)),U)["ADA",(X'["F"),(X["9") S ABM("EX")=";;",ABMP("SCRN")=0 ;ABM*2.6*8 NOHEAT
+9 ;ABM*2.6*8 NOHEAT2
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)["ADA"
IF ((X'["F")&(X'["G"))
IF (X["9")
SET ABM("EX")=";;"
SET ABMP("SCRN")=0
+10 ;abm*2.6*14 HEAT165301 - put below line back in; they should see pg but don't force line to page 3 question
+11 ;ABM*2.6*14 HEAT163711 ;abm*2.6*14 IHS/SD/SDR 5/29/14 HEAT165301 removed line to remove 9A displaying
IF $PIECE($GET(^ABMDEXP(ABMP("EXP"),0)),U)["CMS"
IF ((X'["A")&(X'["E")*(X'["F")&(X'["G"))
IF (X["9")
SET ABM("EX")=";;"
SET ABMP("SCRN")=0
+12 XECUTE ABM("EX")
End DoDot:1
+13 QUIT
