ABMDEMLC ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES - PART 4 ;
;;2.6;IHS Third Party Billing System;**2,3,6,9,10,18,21,27**;NOV 12, 2009;Build 486
;
;IHS/SD/SDR 2.5 P2 5/9/02 NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
;IHS/SD/SDR 2.5 P3 1/22/03 QBA-0103-130075 Modified to use IEN for HCPCS for Fee Schedule lookup
;IHS/SD/SDR 2.5 p5 5/18/04 Modified to put POS and TOS by line item
;IHS/SD/SDR 2.5 p6 7/9/04 IM14079 - Notes regarding removal of TOS for now
;IHS/SD/SDR 2.5 p8 task 6 Added code for POS ambulance default 41
;IHS/SD/SDR 2.5 p9 IM19297 Added message about 4 corresponding Dxs when 837
;IHS/SD/SDR 2.5 p11 Corrections to 4 corr. Dxs. If they answered NO it would put NO on the claim, not the selected Dxs.
;
;IHS/SD/SDR v2.6 CSV
;IHS/SD/SDR 2.6*2 3PMS10003A Modified to call ABMFEAPI
;IHS/SD/SDR 2.6*3 NOHEAT fixed modifiers so they work correctly; it would let user put garbage
;IHS/SD/SDR 2.6*6 5010 added export mode 32
;IHS/SD/SDR 2.6*18 HEAT242924 Added screen when export mode is 33 so only 4 DXs can be selected for the coord. DX.
;IHS/SD/SDR 2.6*21 HEAT168435 Added code to add/edit modifiers for 23 multiple (pharmacy)
;IHS/SD/SDR 2.6*27 CR8894 Fixed API call so charge amount will default if available
;
DX ;EP for selecting Corresponding Diagnosis
I '+$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C","")) W !!,"There are no Diagnosis entered to select from." Q
S ABMX=0 K DIR
W !!,?21,"DIAGNOSES"
;W !,?7,"Seq",?13,"ICD9" ;abm*2.6*10 ICD10 002I
W !,?7,"Seq",?14,"ICD" ;abm*2.6*10 ICD10 002I
;W !,?7,"Num",?13,"Code",?32,"Diagnosis Description" ;abm*2.6*10 ICD10 002I
W !,?7,"Num",?14,"Code",?33,"Diagnosis Description" ;abm*2.6*10 ICD10 002I
;W !,?7,"===",?12,"======",?21,"============================================" ;abm*2.6*10 ICD10 002I
W !,?7,"===",?12,"========",?22,"============================================" ;abm*2.6*10 ICD10 002I
D RES^ABMDEMLA(17)
;F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX)) Q:'ABMX D DX1 ;abm*2.6*18 IHS/SD/SDR HEAT242924
F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX)) Q:'ABMX!(ABMP("EXP")=33&(ABMX("I")>4)) D DX1 ;abm*2.6*18 IHS/SD/SDR HEAT242924
I ABMX("I")=2 D Q
.S Y(0)=1
.S ABMX(1)=1,X=1
S Y(0)=""
K DIC
S DIC="^ABMDCLM(DUZ(2),ABMP(""CDFN""),17,",DIC(0)="AEMQ"
S DIC("A")="Enter Principle Corresponding DX: "
K ABMNY
W ! F D Q:Y<0!(+$G(ABMNY)<0)
.I $G(ABMP("EXP"))=21!($G(ABMP("EXP"))=22)!($G(ABMP("EXP"))=23),$L(Y(0),",")>4 D Q:+$G(ABMNY)<0 ;only 4 corresponding Dxs
..S ABMBFY=Y
..S ABMBFY0=Y(0)
..S DIR("A",1)="STOP!"
..S DIR("A",2)="THE MODE OF EXPORT YOU ARE SUBMITTING FOR ONLY ALLOWS 4 CORRESPONDING"
..S DIR("A",3)="DIAGNOSIS CODES."
..S DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE ENTERING ADDITIONAL CODES?:"
..S DIR("B")="Y"
..S DIR(0)="Y"
..D ^DIR
..K DIR
..I Y=1 S Y=ABMBFY,Y(0)=ABMBFY0
..E S ABMNY=-1,Y=ABMBFY,Y(0)=$P(ABMBFY0,",",1,4)
.I ABMP("EXP")=33 S DIC("S")="I X<5" ;abm*2.6*18 IHS/SD/SDR HEAT242924
.D ^DIC Q:+Y<0
.S DIC("A")="Enter Other Corresponding DX (carriage return when done): "
.S Y(0)=$G(Y(0))
.Q:Y(0)[ABMX(+Y)
.I Y(0)'="" S Y(0)=Y(0)_","
.S Y(0)=Y(0)_ABMX(+Y)
.W " ",Y(0)
K DIC
Q
;
DX1 ;LIST DX'S
S ABMX("X")=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX,"")),ABMX(ABMX("X"))=ABMX("I"),ABMX("X0")=$$DX^ABMCVAPI(ABMX("X"),ABMP("VDT")) ;CSV-c
I $D(ABMX("EDIT")),$D(ABMZ(ABMX("Y"))) S:ABMX("X")=$P(ABMZ(ABMX("Y")),U,5) DIR("B")=ABMX("I")
;W !,?8,ABMX("I"),?12,$P(ABMX("X0"),U,2),?21,$P(ABMX("X0"),U,4) ;CSV-c ;abm*2.6*10 ICD10 002I
W !,?8,ABMX("I"),?12,$P(ABMX("X0"),U,2),?22,$P(ABMX("X0"),U,4) ;CSV-c ;abm*2.6*10 ICD10 002I
Q
;
NARR ;EP for entering Provider's Narrative
W ! K DIC S DIC="^AUTNPOV(",DIC(0)="LXAE"
S DLAYGO=9999999.27
S DIC("B")=$P(ABMX("DICB"),U)
I $E(DIC("B"))=" " F D Q:$E(DIC("B"))'=" "
.S DIC("B")=$P(DIC("B")," ",2,999)
D ^DIC K DIC,DLAYGO
I +Y<0 S Y=$P(ABMX("DICB"),U,2)
Q
;
MOD2 ;EP for editing Modifiers
Q:'$P($G(^ABMDPARM(DUZ(2),1,2)),U,5)
S ABMZIEN=$O(^ICPT("BA",$P(ABMZ(ABMX("Y")),U)_" ",""))
;S ABMZ("CHARGE")=+$P($G(^ABMDFEE(ABMP("FEE"),ABMZ("CAT"),ABMZIEN,0)),U,2) ;abm*2.6*2 3PMS10003A
S ABMZ("CHARGE")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),ABMZIEN,ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A
S ABMZ("MODFEE")=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),0)),U,+$P(ABMZ("CHRG"),".",2))
S ABMX("MC")=ABMZ("CHARGE")
MOD3 ;EP ;abm*2.6*21 IHS/SD/SDR HEAT168435 added line tag
S DIE="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","_ABMZ("SUB")_",",DA=$P(ABMZ(ABMX("Y")),U,2)
S ABMX("M")=$S($P(ABMZ("MOD"),U,4):3,1:1)
F ABMX("I")=1:1:ABMX("M") D
.S DR=$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))
.S ABMX("M",ABMX("I"))=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),$S(+DR<.13:0,1:1))),U,$S($E(DR,$L(+DR))>4:$E(DR,$L(+DR)),1:$E(DR,2,3)))
.I ABMZ("SUB")=23 S ABMX("M",ABMX("I"))=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),2)),U,$E(DR,$L(+DR))+2) ;abm*2.6*21 IHS/SD/SDR HEAT168435
F ABMX("I")=1:1:ABMX("M") D Q:$D(DUOUT)!(ABMX("I")=ABMX("M")) I X="",$G(ABMX("M",ABMX("I")+1))="" Q
.S ABMX("S")=$S(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")
.;S DR=$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))_"Select "_$S($P(ABMZ("MOD"),U,4):ABMX("S")_" ",1:"")_"MODIFIER: " ;abm*2.6*3 NOHEAT
.;start new code abm*2.6*3 NOHEAT
.K DIR,X,Y
.S DIR(0)="PO"_$S($$VERSION^XPDUTL("BCSV")>0:"^DIC(81.3,",1:"^AUTTCMOD(")_":QEM"
.S DIR("A")="Select "_$S(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")_" MODIFIER"
.S:$G(ABMX("M",ABMX("I")))'="" DIR("B")=$G(ABMX("M",ABMX("I")))
.D ^DIR
.S ABMX("ANS","X")=X
.S ABMX("ANS","Y")=$P(Y,U,2)
.I ABMX("ANS","X")="@" D
..K DIR,X,Y
..S DIR(0)="Y"
..S DIR(0)="YO",DIR("A")="Do you wish "_ABMX("M",ABMX("I"))_" DELETED"
..D ^DIR K DIR
..I Y=0 S ABMX("ANS","Y")=ABMX("M",ABMX("I"))
..I Y=1 S ABMX("ANS","Y")="@"
.I ABMX("ANS","X")="" Q
.S DR=$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))_"////"_$P(ABMX("ANS","Y"),U)
.K DIR,X,Y,ABMX("ANS")
.;end new code NOHEAT
.W ! D ^DIE S:$D(Y) DUOUT="" Q:X=""
.I +X,+$P($G(^ABMDMOD(+X,0)),U,4),'$D(ABMZ("RCHARGE")) S ABMX("MC")=$P(^(0),U,4)*ABMZ("CHARGE")
.I +X=52 D
..K ABMZ("RCHARGE")
..K DIR S DIR(0)="N^0:"_ABMX("MC")_":2",DIR("A")="Reduced CHARGE",DIR("B")=$S(+ABMZ("MODFEE")=ABMZ("MODFEE"):ABMZ("MODFEE"),1:ABMX("MC"))
..D ^DIR K DIR S:Y=0!(+Y) ABMZ("RCHARGE")=+Y
Q:ABMX("M")=1
F ABMX("I")=ABMX("M"):-1:1 D
.S DR=$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))
.S ABMX("M",ABMX("I"))=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$P(ABMZ(ABMX("Y")),U,2),$S(+DR<.13:0,1:1))),U,$S($E(DR,$L(+DR))>4:$E(DR,$L(+DR)),1:$E(DR,2,3)))_U_DR
.Q:ABMX("I")=3
.I $P(ABMX("M",ABMX("I")),U)="",$P(ABMX("M",ABMX("I")+1),U)]"" D
..S DR=DR_"////"_$P(ABMX("M",ABMX("I")+1),U) D ^DIE
..S DR=$P(ABMX("M",ABMX("I")+1),U,2)_"///@" D ^DIE
..Q:ABMX("I")=2 Q:$P(ABMX("M",ABMX("I")+2),U)=""
..S DR=$P(ABMX("M",ABMX("I")+1),U,2)_"////"_$P(ABMX("M",ABMX("I")+2),U) D ^DIE
..S DR=$P(ABMX("M",ABMX("I")+2),U,2)_"///@" D ^DIE
Q
;
MOD ;EP for adding a Modifier
K ABMX("MODS")
S ABMZ("MODFEE")="" Q:'$P($G(^ABMDPARM(DUZ(2),1,2)),U,5)
;S ABMZ("CHARGE")=+$P($G(^ABMDFEE(ABMP("FEE"),ABMZ("CAT"),ABMX("Y"),0)),U,2) ;abm*2.6*2 3PMS10003A
;S ABMZ("CHARGE")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),ABMX("Y"),ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*27 IHS/SD/SDR CR8894
S ABMZ("CHARGE")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),$$DINUM^ABMFOFS($P($G(^ICPT(ABMX("Y"),0)),U)),ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*27 IHS/SD/SDR CR8894
S DIC=$S($$VERSION^XPDUTL("BCSV")>0:"^DIC(81.3,",1:"^AUTTCMOD(") ;CSV-c
S DIC(0)="QEAM" ;CSV-c
S ABMX("M")=$S($P(ABMZ("MOD"),U,4):3,1:1)
F ABMX("I")=1:1:ABMX("M") D Q:Y<1
.S ABMX("S")=$S(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")
.D SELMOD Q:Y<1
.I $D(ABMX("MODS",+Y)) W *7,!!,"*** Modifier has already been entered! ***" S ABMX("I")=ABMX("I")-1 Q
.S ABMX("MODS",+Y)=""
.S ABMZ("DR")=ABMZ("DR")_";"_$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))_"////"_$P(Y,"^",2)
.I +Y=52 K DIR S DIR(0)="N^0:"_ABMZ("CHARGE")_":2",DIR("A")="Reduced CHARGE",DIR("B")=ABMZ("CHARGE") D ^DIR K DIR S:Y=0!(+Y) ABMZ("MODFEE")=+Y Q
.Q:ABMZ("MODFEE")
.I $P($G(^ABMDMOD(+Y,0)),U,4) S ABMZ("MODFEE")=$P(^(0),U,4)*ABMZ("CHARGE")
Q
;
SELMOD ;
W ! S DIC("A")="Select "_$S($P(ABMZ("MOD"),U,4):ABMX("S")_" ",1:"")_"MODIFIER: "
D ^DIC
Q
POSA ; EP - place of service
;I "^3^14^15^19^20^22^27"'[ABMP("EXP") Q ;only for HCFAs and 837P ;abm*2.6*6 5010
I "^3^14^15^19^20^22^27^32"'[ABMP("EXP") Q ;only for HCFAs and 837P ;abm*2.6*6 5010
D POS
I $D(ABMZ("DR")) S ABMZ("DR")=ABMZ("DR")_";.15T//"_ABMDFLT
E S ABMZ("DR")=";W !;.15T//"_ABMDFLT
Q
POS ; figure place of service
; set place of service
; 21 if visit type is inpatient
; 24 if visit type is ambulatory surgery
; 23 if clinic is emergency medicine (code 30)
; 11 for all other cases
S ABMDFLT=$S(ABMP("VTYP")=111!($G(ABMP("BTYP"))=111):21,ABMP("VTYP")=831:24,1:11)
; if place of service set to 11 check to see if pointer exists
; in parameter file to code file and use it
I ABMDFLT=11 D
. S ABMPTR=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),"^",6)
. S:ABMPTR="" ABMPTR=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",6) Q:'ABMPTR
. Q:'$D(^ABMDCODE(ABMPTR,0))
. S ABMDFLT=$P(^ABMDCODE(ABMPTR,0),U)
I $P($G(^DIC(40.7,+ABMP("CLN"),0)),"^",2)=30 D
. S ABMDFLT=23
I $P($G(^DIC(40.7,+ABMP("CLN"),0)),"^",2)="A3" D
. S ABMDFLT=41
Q
TOSA ; EP - add type of service
; 7/9/04 - Call to this tag have been commented out. This is marked as NOT USED
; in 837 implementation guide. If it is determined that it really is needed tags
; can be restored in ABMDEML and ABMDEMLE
I "^3^14^15^19^20^22"'[ABMP("EXP") Q ;only for HCFAs and 837P
S ABMDFLT=""
S:ABMP("SB")=21 ABMDFLT=1 ;surg
S:ABMP("SB")=23 ABMDFLT=9 ;Rx
S:ABMP("SB")=27 ABMDFLT=1 ;Medical
S:ABMP("SB")=33 ABMDFLT=9 ;Dental
S:ABMP("SB")=35 ABMDFLT=4 ;Rad
S:ABMP("SB")=37 ABMDFLT=5 ;Lab
S:ABMP("SB")=39 ABMDFLT=7 ;Anes
S:ABMP("SB")=43 ABMDFLT=1 ;Misc
S:ABMP("SB")=47 ABMDFLT="AMBULANCE" ;Ambulance
I $D(ABMZ("DR")) S ABMZ("DR")=ABMZ("DR")_";.16T//"_ABMDFLT
E S ABMZ("DR")=";W !;.16T//"_ABMDFLT
Q
ABMDEMLC ; IHS/ASDST/DMJ - Edit Utility - FOR MULTIPLES - PART 4 ;
+1 ;;2.6;IHS Third Party Billing System;**2,3,6,9,10,18,21,27**;NOV 12, 2009;Build 486
+2 ;
+3 ;IHS/SD/SDR 2.5 P2 5/9/02 NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units
+4 ;IHS/SD/SDR 2.5 P3 1/22/03 QBA-0103-130075 Modified to use IEN for HCPCS for Fee Schedule lookup
+5 ;IHS/SD/SDR 2.5 p5 5/18/04 Modified to put POS and TOS by line item
+6 ;IHS/SD/SDR 2.5 p6 7/9/04 IM14079 - Notes regarding removal of TOS for now
+7 ;IHS/SD/SDR 2.5 p8 task 6 Added code for POS ambulance default 41
+8 ;IHS/SD/SDR 2.5 p9 IM19297 Added message about 4 corresponding Dxs when 837
+9 ;IHS/SD/SDR 2.5 p11 Corrections to 4 corr. Dxs. If they answered NO it would put NO on the claim, not the selected Dxs.
+10 ;
+11 ;IHS/SD/SDR v2.6 CSV
+12 ;IHS/SD/SDR 2.6*2 3PMS10003A Modified to call ABMFEAPI
+13 ;IHS/SD/SDR 2.6*3 NOHEAT fixed modifiers so they work correctly; it would let user put garbage
+14 ;IHS/SD/SDR 2.6*6 5010 added export mode 32
+15 ;IHS/SD/SDR 2.6*18 HEAT242924 Added screen when export mode is 33 so only 4 DXs can be selected for the coord. DX.
+16 ;IHS/SD/SDR 2.6*21 HEAT168435 Added code to add/edit modifiers for 23 multiple (pharmacy)
+17 ;IHS/SD/SDR 2.6*27 CR8894 Fixed API call so charge amount will default if available
+18 ;
DX ;EP for selecting Corresponding Diagnosis
+1 IF '+$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",""))
WRITE !!,"There are no Diagnosis entered to select from."
QUIT
+2 SET ABMX=0
KILL DIR
+3 WRITE !!,?21,"DIAGNOSES"
+4 ;W !,?7,"Seq",?13,"ICD9" ;abm*2.6*10 ICD10 002I
+5 ;abm*2.6*10 ICD10 002I
WRITE !,?7,"Seq",?14,"ICD"
+6 ;W !,?7,"Num",?13,"Code",?32,"Diagnosis Description" ;abm*2.6*10 ICD10 002I
+7 ;abm*2.6*10 ICD10 002I
WRITE !,?7,"Num",?14,"Code",?33,"Diagnosis Description"
+8 ;W !,?7,"===",?12,"======",?21,"============================================" ;abm*2.6*10 ICD10 002I
+9 ;abm*2.6*10 ICD10 002I
WRITE !,?7,"===",?12,"========",?22,"============================================"
+10 DO RES^ABMDEMLA(17)
+11 ;F ABMX("I")=1:1 S ABMX=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX)) Q:'ABMX D DX1 ;abm*2.6*18 IHS/SD/SDR HEAT242924
+12 ;abm*2.6*18 IHS/SD/SDR HEAT242924
FOR ABMX("I")=1:1
SET ABMX=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX))
IF 'ABMX!(ABMP("EXP")=33&(ABMX("I")>4))
QUIT
DO DX1
+13 IF ABMX("I")=2
Begin DoDot:1
+14 SET Y(0)=1
+15 SET ABMX(1)=1
SET X=1
End DoDot:1
QUIT
+16 SET Y(0)=""
+17 KILL DIC
+18 SET DIC="^ABMDCLM(DUZ(2),ABMP(""CDFN""),17,"
SET DIC(0)="AEMQ"
+19 SET DIC("A")="Enter Principle Corresponding DX: "
+20 KILL ABMNY
+21 WRITE !
FOR
Begin DoDot:1
+22 ;only 4 corresponding Dxs
IF $GET(ABMP("EXP"))=21!($GET(ABMP("EXP"))=22)!($GET(ABMP("EXP"))=23)
IF $LENGTH(Y(0),",")>4
Begin DoDot:2
+23 SET ABMBFY=Y
+24 SET ABMBFY0=Y(0)
+25 SET DIR("A",1)="STOP!"
+26 SET DIR("A",2)="THE MODE OF EXPORT YOU ARE SUBMITTING FOR ONLY ALLOWS 4 CORRESPONDING"
+27 SET DIR("A",3)="DIAGNOSIS CODES."
+28 SET DIR("A")="ARE YOU SURE YOU WANT TO CONTINUE ENTERING ADDITIONAL CODES?:"
+29 SET DIR("B")="Y"
+30 SET DIR(0)="Y"
+31 DO ^DIR
+32 KILL DIR
+33 IF Y=1
SET Y=ABMBFY
SET Y(0)=ABMBFY0
+34 IF '$TEST
SET ABMNY=-1
SET Y=ABMBFY
SET Y(0)=$PIECE(ABMBFY0,",",1,4)
End DoDot:2
IF +$GET(ABMNY)<0
QUIT
+35 ;abm*2.6*18 IHS/SD/SDR HEAT242924
IF ABMP("EXP")=33
SET DIC("S")="I X<5"
+36 DO ^DIC
IF +Y<0
QUIT
+37 SET DIC("A")="Enter Other Corresponding DX (carriage return when done): "
+38 SET Y(0)=$GET(Y(0))
+39 IF Y(0)[ABMX(+Y)
QUIT
+40 IF Y(0)'=""
SET Y(0)=Y(0)_","
+41 SET Y(0)=Y(0)_ABMX(+Y)
+42 WRITE " ",Y(0)
End DoDot:1
IF Y<0!(+$GET(ABMNY)<0)
QUIT
+43 KILL DIC
+44 QUIT
+45 ;
DX1 ;LIST DX'S
+1 ;CSV-c
SET ABMX("X")=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),17,"C",ABMX,""))
SET ABMX(ABMX("X"))=ABMX("I")
SET ABMX("X0")=$$DX^ABMCVAPI(ABMX("X"),ABMP("VDT"))
+2 IF $DATA(ABMX("EDIT"))
IF $DATA(ABMZ(ABMX("Y")))
IF ABMX("X")=$PIECE(ABMZ(ABMX("Y")),U,5)
SET DIR("B")=ABMX("I")
+3 ;W !,?8,ABMX("I"),?12,$P(ABMX("X0"),U,2),?21,$P(ABMX("X0"),U,4) ;CSV-c ;abm*2.6*10 ICD10 002I
+4 ;CSV-c ;abm*2.6*10 ICD10 002I
WRITE !,?8,ABMX("I"),?12,$PIECE(ABMX("X0"),U,2),?22,$PIECE(ABMX("X0"),U,4)
+5 QUIT
+6 ;
NARR ;EP for entering Provider's Narrative
+1 WRITE !
KILL DIC
SET DIC="^AUTNPOV("
SET DIC(0)="LXAE"
+2 SET DLAYGO=9999999.27
+3 SET DIC("B")=$PIECE(ABMX("DICB"),U)
+4 IF $EXTRACT(DIC("B"))=" "
FOR
Begin DoDot:1
+5 SET DIC("B")=$PIECE(DIC("B")," ",2,999)
End DoDot:1
IF $EXTRACT(DIC("B"))'=" "
QUIT
+6 DO ^DIC
KILL DIC,DLAYGO
+7 IF +Y<0
SET Y=$PIECE(ABMX("DICB"),U,2)
+8 QUIT
+9 ;
MOD2 ;EP for editing Modifiers
+1 IF '$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,5)
QUIT
+2 SET ABMZIEN=$ORDER(^ICPT("BA",$PIECE(ABMZ(ABMX("Y")),U)_" ",""))
+3 ;S ABMZ("CHARGE")=+$P($G(^ABMDFEE(ABMP("FEE"),ABMZ("CAT"),ABMZIEN,0)),U,2) ;abm*2.6*2 3PMS10003A
+4 ;abm*2.6*2 3PMS10003A
SET ABMZ("CHARGE")=+$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),ABMZIEN,ABMP("VDT")),U)
+5 SET ABMZ("MODFEE")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),0)),U,+$PIECE(ABMZ("CHRG"),".",2))
+6 SET ABMX("MC")=ABMZ("CHARGE")
MOD3 ;EP ;abm*2.6*21 IHS/SD/SDR HEAT168435 added line tag
+1 SET DIE="^ABMDCLM(DUZ(2),"_ABMP("CDFN")_","_ABMZ("SUB")_","
SET DA=$PIECE(ABMZ(ABMX("Y")),U,2)
+2 SET ABMX("M")=$SELECT($PIECE(ABMZ("MOD"),U,4):3,1:1)
+3 FOR ABMX("I")=1:1:ABMX("M")
Begin DoDot:1
+4 SET DR=$SELECT(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$PIECE(ABMZ("MOD"),U,3),1:$PIECE(ABMZ("MOD"),U,4))
+5 SET ABMX("M",ABMX("I"))=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),$SELECT(+DR<.13:0,1:1))),U,$SELECT($EXTRACT(DR,$LENGTH(+DR))>4:$EXTRACT(DR,$LENGTH(+DR)),1:$EXTRACT(DR,2,3)))
+6 ;abm*2.6*21 IHS/SD/SDR HEAT168435
IF ABMZ("SUB")=23
SET ABMX("M",ABMX("I"))=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),2)),U,$EXTRACT(DR,$LENGTH(+DR))+2)
End DoDot:1
+7 FOR ABMX("I")=1:1:ABMX("M")
Begin DoDot:1
+8 SET ABMX("S")=$SELECT(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")
+9 ;S DR=$S(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$P(ABMZ("MOD"),U,3),1:$P(ABMZ("MOD"),U,4))_"Select "_$S($P(ABMZ("MOD"),U,4):ABMX("S")_" ",1:"")_"MODIFIER: " ;abm*2.6*3 NOHEAT
+10 ;start new code abm*2.6*3 NOHEAT
+11 KILL DIR,X,Y
+12 SET DIR(0)="PO"_$SELECT($$VERSION^XPDUTL("BCSV")>0:"^DIC(81.3,",1:"^AUTTCMOD(")_":QEM"
+13 SET DIR("A")="Select "_$SELECT(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")_" MODIFIER"
+14 IF $GET(ABMX("M",ABMX("I")))'=""
SET DIR("B")=$GET(ABMX("M",ABMX("I")))
+15 DO ^DIR
+16 SET ABMX("ANS","X")=X
+17 SET ABMX("ANS","Y")=$PIECE(Y,U,2)
+18 IF ABMX("ANS","X")="@"
Begin DoDot:2
+19 KILL DIR,X,Y
+20 SET DIR(0)="Y"
+21 SET DIR(0)="YO"
SET DIR("A")="Do you wish "_ABMX("M",ABMX("I"))_" DELETED"
+22 DO ^DIR
KILL DIR
+23 IF Y=0
SET ABMX("ANS","Y")=ABMX("M",ABMX("I"))
+24 IF Y=1
SET ABMX("ANS","Y")="@"
End DoDot:2
+25 IF ABMX("ANS","X")=""
QUIT
+26 SET DR=$SELECT(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$PIECE(ABMZ("MOD"),U,3),1:$PIECE(ABMZ("MOD"),U,4))_"////"_$PIECE(ABMX("ANS","Y"),U)
+27 KILL DIR,X,Y,ABMX("ANS")
+28 ;end new code NOHEAT
+29 WRITE !
DO ^DIE
IF $DATA(Y)
SET DUOUT=""
IF X=""
QUIT
+30 IF +X
IF +$PIECE($GET(^ABMDMOD(+X,0)),U,4)
IF '$DATA(ABMZ("RCHARGE"))
SET ABMX("MC")=$PIECE(^(0),U,4)*ABMZ("CHARGE")
+31 IF +X=52
Begin DoDot:2
+32 KILL ABMZ("RCHARGE")
+33 KILL DIR
SET DIR(0)="N^0:"_ABMX("MC")_":2"
SET DIR("A")="Reduced CHARGE"
SET DIR("B")=$SELECT(+ABMZ("MODFEE")=ABMZ("MODFEE"):ABMZ("MODFEE"),1:ABMX("MC"))
+34 DO ^DIR
KILL DIR
IF Y=0!(+Y)
SET ABMZ("RCHARGE")=+Y
End DoDot:2
End DoDot:1
IF $DATA(DUOUT)!(ABMX("I")=ABMX("M"))
QUIT
IF X=""
IF $GET(ABMX("M",ABMX("I")+1))=""
QUIT
+35 IF ABMX("M")=1
QUIT
+36 FOR ABMX("I")=ABMX("M"):-1:1
Begin DoDot:1
+37 SET DR=$SELECT(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$PIECE(ABMZ("MOD"),U,3),1:$PIECE(ABMZ("MOD"),U,4))
+38 SET ABMX("M",ABMX("I"))=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),ABMZ("SUB"),$PIECE(ABMZ(ABMX("Y")),U,2),$SELECT(+DR<.13:0,1:1))),U,$SELECT($EXTRACT(DR,$LENGTH(+DR))>4:$EXTRACT(DR,$LENGTH(+DR)),1:$EXTRACT(DR,2,3)))_U_DR
+39 IF ABMX("I")=3
QUIT
+40 IF $PIECE(ABMX("M",ABMX("I")),U)=""
IF $PIECE(ABMX("M",ABMX("I")+1),U)]""
Begin DoDot:2
+41 SET DR=DR_"////"_$PIECE(ABMX("M",ABMX("I")+1),U)
DO ^DIE
+42 SET DR=$PIECE(ABMX("M",ABMX("I")+1),U,2)_"///@"
DO ^DIE
+43 IF ABMX("I")=2
QUIT
IF $PIECE(ABMX("M",ABMX("I")+2),U)=""
QUIT
+44 SET DR=$PIECE(ABMX("M",ABMX("I")+1),U,2)_"////"_$PIECE(ABMX("M",ABMX("I")+2),U)
DO ^DIE
+45 SET DR=$PIECE(ABMX("M",ABMX("I")+2),U,2)_"///@"
DO ^DIE
End DoDot:2
End DoDot:1
+46 QUIT
+47 ;
MOD ;EP for adding a Modifier
+1 KILL ABMX("MODS")
+2 SET ABMZ("MODFEE")=""
IF '$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,5)
QUIT
+3 ;S ABMZ("CHARGE")=+$P($G(^ABMDFEE(ABMP("FEE"),ABMZ("CAT"),ABMX("Y"),0)),U,2) ;abm*2.6*2 3PMS10003A
+4 ;S ABMZ("CHARGE")=+$P($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),ABMX("Y"),ABMP("VDT")),U) ;abm*2.6*2 3PMS10003A ;abm*2.6*27 IHS/SD/SDR CR8894
+5 ;abm*2.6*2 3PMS10003A ;abm*2.6*27 IHS/SD/SDR CR8894
SET ABMZ("CHARGE")=+$PIECE($$ONE^ABMFEAPI(ABMP("FEE"),ABMZ("CAT"),$$DINUM^ABMFOFS($PIECE($GET(^ICPT(ABMX("Y"),0)),U)),ABMP("VDT")),U)
+6 ;CSV-c
SET DIC=$SELECT($$VERSION^XPDUTL("BCSV")>0:"^DIC(81.3,",1:"^AUTTCMOD(")
+7 ;CSV-c
SET DIC(0)="QEAM"
+8 SET ABMX("M")=$SELECT($PIECE(ABMZ("MOD"),U,4):3,1:1)
+9 FOR ABMX("I")=1:1:ABMX("M")
Begin DoDot:1
+10 SET ABMX("S")=$SELECT(ABMX("I")=1:"1st",ABMX("I")=2:"2nd",1:"3rd")
+11 DO SELMOD
IF Y<1
QUIT
+12 IF $DATA(ABMX("MODS",+Y))
WRITE *7,!!,"*** Modifier has already been entered! ***"
SET ABMX("I")=ABMX("I")-1
QUIT
+13 SET ABMX("MODS",+Y)=""
+14 SET ABMZ("DR")=ABMZ("DR")_";"_$SELECT(ABMX("I")=1:+ABMZ("MOD"),ABMX("I")=2:$PIECE(ABMZ("MOD"),U,3),1:$PIECE(ABMZ("MOD"),U,4))_"////"_$PIECE(Y,"^",2)
+15 IF +Y=52
KILL DIR
SET DIR(0)="N^0:"_ABMZ("CHARGE")_":2"
SET DIR("A")="Reduced CHARGE"
SET DIR("B")=ABMZ("CHARGE")
DO ^DIR
KILL DIR
IF Y=0!(+Y)
SET ABMZ("MODFEE")=+Y
QUIT
+16 IF ABMZ("MODFEE")
QUIT
+17 IF $PIECE($GET(^ABMDMOD(+Y,0)),U,4)
SET ABMZ("MODFEE")=$PIECE(^(0),U,4)*ABMZ("CHARGE")
End DoDot:1
IF Y<1
QUIT
+18 QUIT
+19 ;
SELMOD ;
+1 WRITE !
SET DIC("A")="Select "_$SELECT($PIECE(ABMZ("MOD"),U,4):ABMX("S")_" ",1:"")_"MODIFIER: "
+2 DO ^DIC
+3 QUIT
POSA ; EP - place of service
+1 ;I "^3^14^15^19^20^22^27"'[ABMP("EXP") Q ;only for HCFAs and 837P ;abm*2.6*6 5010
+2 ;only for HCFAs and 837P ;abm*2.6*6 5010
IF "^3^14^15^19^20^22^27^32"'[ABMP("EXP")
QUIT
+3 DO POS
+4 IF $DATA(ABMZ("DR"))
SET ABMZ("DR")=ABMZ("DR")_";.15T//"_ABMDFLT
+5 IF '$TEST
SET ABMZ("DR")=";W !;.15T//"_ABMDFLT
+6 QUIT
POS ; figure place of service
+1 ; set place of service
+2 ; 21 if visit type is inpatient
+3 ; 24 if visit type is ambulatory surgery
+4 ; 23 if clinic is emergency medicine (code 30)
+5 ; 11 for all other cases
+6 SET ABMDFLT=$SELECT(ABMP("VTYP")=111!($GET(ABMP("BTYP"))=111):21,ABMP("VTYP")=831:24,1:11)
+7 ; if place of service set to 11 check to see if pointer exists
+8 ; in parameter file to code file and use it
+9 IF ABMDFLT=11
Begin DoDot:1
+10 SET ABMPTR=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),"^",6)
+11 IF ABMPTR=""
SET ABMPTR=$PIECE($GET(^ABMDPARM(DUZ(2),1,3)),"^",6)
IF 'ABMPTR
QUIT
+12 IF '$DATA(^ABMDCODE(ABMPTR,0))
QUIT
+13 SET ABMDFLT=$PIECE(^ABMDCODE(ABMPTR,0),U)
End DoDot:1
+14 IF $PIECE($GET(^DIC(40.7,+ABMP("CLN"),0)),"^",2)=30
Begin DoDot:1
+15 SET ABMDFLT=23
End DoDot:1
+16 IF $PIECE($GET(^DIC(40.7,+ABMP("CLN"),0)),"^",2)="A3"
Begin DoDot:1
+17 SET ABMDFLT=41
End DoDot:1
+18 QUIT
TOSA ; EP - add type of service
+1 ; 7/9/04 - Call to this tag have been commented out. This is marked as NOT USED
+2 ; in 837 implementation guide. If it is determined that it really is needed tags
+3 ; can be restored in ABMDEML and ABMDEMLE
+4 ;only for HCFAs and 837P
IF "^3^14^15^19^20^22"'[ABMP("EXP")
QUIT
+5 SET ABMDFLT=""
+6 ;surg
IF ABMP("SB")=21
SET ABMDFLT=1
+7 ;Rx
IF ABMP("SB")=23
SET ABMDFLT=9
+8 ;Medical
IF ABMP("SB")=27
SET ABMDFLT=1
+9 ;Dental
IF ABMP("SB")=33
SET ABMDFLT=9
+10 ;Rad
IF ABMP("SB")=35
SET ABMDFLT=4
+11 ;Lab
IF ABMP("SB")=37
SET ABMDFLT=5
+12 ;Anes
IF ABMP("SB")=39
SET ABMDFLT=7
+13 ;Misc
IF ABMP("SB")=43
SET ABMDFLT=1
+14 ;Ambulance
IF ABMP("SB")=47
SET ABMDFLT="AMBULANCE"
+15 IF $DATA(ABMZ("DR"))
SET ABMZ("DR")=ABMZ("DR")_";.16T//"_ABMDFLT
+16 IF '$TEST
SET ABMZ("DR")=";W !;.16T//"_ABMDFLT
+17 QUIT
