- 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
