ABMDE8 ; IHS/ASDST/DMJ - Edit Page 8 - WORKSHEET DATA ;
;;2.6;IHS 3P BILLING SYSTEM;**23**;NOV 12, 2009;Build 427
;
;IHS/DSD/DMJ - 6/17/98 - NOIS CKA-0698-110070 odified to include more than just room charges on Page 8C
;
;IHS/SD/SDR - 10/15/02 - V2.5 P2 - 888-0501-N0008 Modified to put Supplies lock on Charge Master page instead of Medical
;IHS/SD/EFG - V2.5 P8 - IM16385 Modified to allow page 8H to display when vt=998 (dental)
;IHS/SD/SDR - v2.5 p8 - task 6 Added code for new page 8K
;IHS/SD/SDR - v2.5 p10 - IM20329 Display anesthesia page if anesthesia charge on visit
;
;IHS/SD/AML 2.6*23 HEAT247169 Made page 8H display if the visit type is 997 Pharmacy
;
A ;EP - Entry Point to Page 8A
S ABMP("LBL")="A",ABMP("LOC")=10,ABMP("SB")=27 G SCRN ;MEDICAL
B ;EP - Entry Point to Page 8B
S ABMP("LBL")="B",ABMP("LOC")=1,ABMP("SB")=21 G SCRN ;SURGICAL
C ;EP - Entry Point to Page 8C
S ABMP("LBL")="C",ABMP("LOC")=2,ABMP("SB")=25 G SCRN ;R&B
D ;EP - Entry Point to Page 8D
S ABMP("LBL")="D",ABMP("LOC")=6,ABMP("SB")=23 G SCRN ;RX
E ;EP - Entry Point to Page 8E
S ABMP("LBL")="E",ABMP("LOC")=3,ABMP("SB")=37 G SCRN ;LAB
F ;EP - Entry Point to Page 8F
S ABMP("LBL")="F",ABMP("LOC")=4,ABMP("SB")=35 G SCRN ;XRAY
G ;EP - Entry Point to Page 8G
S ABMP("LBL")="G",ABMP("LOC")=5,ABMP("SB")=39 G SCRN ;ANESTH
H ;EP - Entry Point to Page 8H
S ABMP("LBL")="H",ABMP("LOC")=8,ABMP("SB")=43 G SCRN ;MISC
I ;EP - Entry Point to Page 8I
S ABMP("LBL")="I",ABMP("LOC")=7,ABMP("SB")=33 G SCRN ;DDS
J ;EP - Entry Point to Page 8J
S ABMP("LBL")="J",ABMP("LOC")=9,ABMP("SB")=45 G SCRN ;SUPPLY
K ;EP - Entry point to page 8K
S ABMP("LBL")="K",ABMP("LOC")=8,ABMP("SB")=47 G SCRN ;AMBULANCE
;
SCRN K ABM,ABME,DUOUT,DTOUT,DIROUT,DIRUT
I $P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3",("ABCDEFGIJ"[ABMP("LBL")) G CHK
I $P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)'="A3",("K"[ABMP("LBL")) G CHK
I ABMP("LBL")="G" D CPTLIST^ABMCPTCK(ABMP("CDFN")) I '$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0)),'$D(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,0)),($O(ABMCPTS(70000),-1)=1) G CHK
I ABMP("VTYP")=998,"CI"[ABMP("LBL") G CHK
I $D(ABMP("DDL"))!$D(ABMP("WORKSHEET")),'+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMP("SB"),0)) G CHK
I ABMP("VTYP")'=111&(ABMP("LBL")="I") G CHK
I $D(^ABMDPARM(DUZ(2),1,11,ABMP("LOC"))) G CHK
;I ABMP("VTYP")=997,ABMP("LBL")'="D" G CHK ;abm*2.6*23 IHS/SD/AML HEAT247169
I ABMP("VTYP")=997,"DH"'[ABMP("LBL") G CHK ;abm*2.6*23 IHS/SD/AML HEAT247169
I ABMP("VTYP")=996,ABMP("LBL")'="E" G CHK
I ABMP("VTYP")=995,ABMP("LBL")'="F" G CHK
D @("^ABMDE8"_ABMP("LBL")) W ! S ABMP("OPT")=$S(ABMP("LBL")="B":"ADESVNJBQM",1:"ADEVNJBQM") D SEL^ABMDEOPT
CHK I "AENVSDBM"'[$E(Y) G XIT
I ABMP("LBL")="K",$E(Y)="N" S:$D(ABMP("DDL"))&($E(ABMP("PAGE"),$L(ABMP("PAGE")))=8!($D(ABMP("WORKSHEET")))) ABMP("QUIT")="" G XIT
G XIT:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)!(ABMP("LBL")="A"&($E(Y)="B"))
I $E(Y)="B" S ABMP("LBL")=$C($A(ABMP("LBL"))-1) G @(ABMP("LBL"))
I $E(Y)="N" S ABMP("LBL")=$C($A(ABMP("LBL"))+1) G @(ABMP("LBL"))
I $E(Y)="V" S ABM("DO")=$S("AB"[ABMP("LBL"):"^ABMDE5B",ABMP("LBL")="C":"^ABMDE8CA",ABMP("LBL")="E":"^ABMDE8EA",ABMP("LBL")="D":"^ABMDE8DA",1:"V1") D @ABM("DO") G SCRN
S ABM("DO")=$S($E(Y)="E":"E1^ABMDEMLE",$E(Y)="A":"A1^ABMDEML",$E(Y)="D":"D1^ABMDEMLB",1:"S1^ABMDEMLA")
N I F I="C","D","J" D
.I ABMP("LBL")=I,"AE"[$E(Y) S ABM("DO")=$E(Y)_"^ABMDE8"_I
S:$E(Y)="M" ABM("DO")="MODE"
D @ABM("DO")
G SCRN
;
V1 S ABMZ("TITL")="PAGE 8 - VIEW OPTION" D SUM^ABMDE1
D ^ABMDERR
Q
MODE ;CHANGE MODE OF EXPORT THIS PAGE
W !
S DR=$A(ABMP("LBL"))+6
S DIE="^ABMDCLM(DUZ(2),"
S DA=ABMP("CDFN")
D ^DIE
D EXP^ABMDEVAR
Q
RBLD ;REBUILD PAGE LINE ITEMS FROM PCC
Q
;
XIT K ABM,ABMZ,ABME,ABMP("LOC"),ABMP("LBL")
Q
ABMDE8 ; IHS/ASDST/DMJ - Edit Page 8 - WORKSHEET DATA ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**23**;NOV 12, 2009;Build 427
+2 ;
+3 ;IHS/DSD/DMJ - 6/17/98 - NOIS CKA-0698-110070 odified to include more than just room charges on Page 8C
+4 ;
+5 ;IHS/SD/SDR - 10/15/02 - V2.5 P2 - 888-0501-N0008 Modified to put Supplies lock on Charge Master page instead of Medical
+6 ;IHS/SD/EFG - V2.5 P8 - IM16385 Modified to allow page 8H to display when vt=998 (dental)
+7 ;IHS/SD/SDR - v2.5 p8 - task 6 Added code for new page 8K
+8 ;IHS/SD/SDR - v2.5 p10 - IM20329 Display anesthesia page if anesthesia charge on visit
+9 ;
+10 ;IHS/SD/AML 2.6*23 HEAT247169 Made page 8H display if the visit type is 997 Pharmacy
+11 ;
A ;EP - Entry Point to Page 8A
+1 ;MEDICAL
SET ABMP("LBL")="A"
SET ABMP("LOC")=10
SET ABMP("SB")=27
GOTO SCRN
B ;EP - Entry Point to Page 8B
+1 ;SURGICAL
SET ABMP("LBL")="B"
SET ABMP("LOC")=1
SET ABMP("SB")=21
GOTO SCRN
C ;EP - Entry Point to Page 8C
+1 ;R&B
SET ABMP("LBL")="C"
SET ABMP("LOC")=2
SET ABMP("SB")=25
GOTO SCRN
D ;EP - Entry Point to Page 8D
+1 ;RX
SET ABMP("LBL")="D"
SET ABMP("LOC")=6
SET ABMP("SB")=23
GOTO SCRN
E ;EP - Entry Point to Page 8E
+1 ;LAB
SET ABMP("LBL")="E"
SET ABMP("LOC")=3
SET ABMP("SB")=37
GOTO SCRN
F ;EP - Entry Point to Page 8F
+1 ;XRAY
SET ABMP("LBL")="F"
SET ABMP("LOC")=4
SET ABMP("SB")=35
GOTO SCRN
G ;EP - Entry Point to Page 8G
+1 ;ANESTH
SET ABMP("LBL")="G"
SET ABMP("LOC")=5
SET ABMP("SB")=39
GOTO SCRN
H ;EP - Entry Point to Page 8H
+1 ;MISC
SET ABMP("LBL")="H"
SET ABMP("LOC")=8
SET ABMP("SB")=43
GOTO SCRN
I ;EP - Entry Point to Page 8I
+1 ;DDS
SET ABMP("LBL")="I"
SET ABMP("LOC")=7
SET ABMP("SB")=33
GOTO SCRN
J ;EP - Entry Point to Page 8J
+1 ;SUPPLY
SET ABMP("LBL")="J"
SET ABMP("LOC")=9
SET ABMP("SB")=45
GOTO SCRN
K ;EP - Entry point to page 8K
+1 ;AMBULANCE
SET ABMP("LBL")="K"
SET ABMP("LOC")=8
SET ABMP("SB")=47
GOTO SCRN
+2 ;
SCRN KILL ABM,ABME,DUOUT,DTOUT,DIROUT,DIRUT
+1 IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3"
IF ("ABCDEFGIJ"[ABMP("LBL"))
GOTO CHK
+2 IF $PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)'="A3"
IF ("K"[ABMP("LBL"))
GOTO CHK
+3 IF ABMP("LBL")="G"
DO CPTLIST^ABMCPTCK(ABMP("CDFN"))
IF '$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),21,0))
IF '$DATA(^ABMDCLM(DUZ(2),ABMP("CDFN"),39,0))
IF ($ORDER(ABMCPTS(70000),-1)=1)
GOTO CHK
+4 IF ABMP("VTYP")=998
IF "CI"[ABMP("LBL")
GOTO CHK
+5 IF $DATA(ABMP("DDL"))!$DATA(ABMP("WORKSHEET"))
IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMP("SB"),0))
GOTO CHK
+6 IF ABMP("VTYP")'=111&(ABMP("LBL")="I")
GOTO CHK
+7 IF $DATA(^ABMDPARM(DUZ(2),1,11,ABMP("LOC")))
GOTO CHK
+8 ;I ABMP("VTYP")=997,ABMP("LBL")'="D" G CHK ;abm*2.6*23 IHS/SD/AML HEAT247169
+9 ;abm*2.6*23 IHS/SD/AML HEAT247169
IF ABMP("VTYP")=997
IF "DH"'[ABMP("LBL")
GOTO CHK
+10 IF ABMP("VTYP")=996
IF ABMP("LBL")'="E"
GOTO CHK
+11 IF ABMP("VTYP")=995
IF ABMP("LBL")'="F"
GOTO CHK
+12 DO @("^ABMDE8"_ABMP("LBL"))
WRITE !
SET ABMP("OPT")=$SELECT(ABMP("LBL")="B":"ADESVNJBQM",1:"ADEVNJBQM")
DO SEL^ABMDEOPT
CHK IF "AENVSDBM"'[$EXTRACT(Y)
GOTO XIT
+1 IF ABMP("LBL")="K"
IF $EXTRACT(Y)="N"
IF $DATA(ABMP("DDL"))&($EXTRACT(ABMP("PAGE"),$LENGTH(ABMP("PAGE")))=8!($DATA(ABMP("WORKSHEET"))))
SET ABMP("QUIT")=""
GOTO XIT
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)!(ABMP("LBL")="A"&($EXTRACT(Y)="B"))
GOTO XIT
+3 IF $EXTRACT(Y)="B"
SET ABMP("LBL")=$CHAR($ASCII(ABMP("LBL"))-1)
GOTO @(ABMP("LBL"))
+4 IF $EXTRACT(Y)="N"
SET ABMP("LBL")=$CHAR($ASCII(ABMP("LBL"))+1)
GOTO @(ABMP("LBL"))
+5 IF $EXTRACT(Y)="V"
SET ABM("DO")=$SELECT("AB"[ABMP("LBL"):"^ABMDE5B",ABMP("LBL")="C":"^ABMDE8CA",ABMP("LBL")="E":"^ABMDE8EA",ABMP("LBL")="D":"^ABMDE8DA",1:"V1")
DO @ABM("DO")
GOTO SCRN
+6 SET ABM("DO")=$SELECT($EXTRACT(Y)="E":"E1^ABMDEMLE",$EXTRACT(Y)="A":"A1^ABMDEML",$EXTRACT(Y)="D":"D1^ABMDEMLB",1:"S1^ABMDEMLA")
+7 NEW I
FOR I="C","D","J"
Begin DoDot:1
+8 IF ABMP("LBL")=I
IF "AE"[$EXTRACT(Y)
SET ABM("DO")=$EXTRACT(Y)_"^ABMDE8"_I
End DoDot:1
+9 IF $EXTRACT(Y)="M"
SET ABM("DO")="MODE"
+10 DO @ABM("DO")
+11 GOTO SCRN
+12 ;
V1 SET ABMZ("TITL")="PAGE 8 - VIEW OPTION"
DO SUM^ABMDE1
+1 DO ^ABMDERR
+2 QUIT
MODE ;CHANGE MODE OF EXPORT THIS PAGE
+1 WRITE !
+2 SET DR=$ASCII(ABMP("LBL"))+6
+3 SET DIE="^ABMDCLM(DUZ(2),"
+4 SET DA=ABMP("CDFN")
+5 DO ^DIE
+6 DO EXP^ABMDEVAR
+7 QUIT
RBLD ;REBUILD PAGE LINE ITEMS FROM PCC
+1 QUIT
+2 ;
XIT KILL ABM,ABMZ,ABME,ABMP("LOC"),ABMP("LBL")
+1 QUIT
