Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ABMDEMLC

ABMDEMLC.m

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