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

ABMDFOVR.m

Go to the documentation of this file. 
  1. ABMDFOVR ; IHS/ASDST/DMJ - Set Up Form Override ;   
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**10,13,21**;NOV 12, 2009;Build 379
  1.  ;IHS/DSD/MRS - Added hcfa block 11c 11/25/1998
  1.  ;
  1.  ;IHS/SD/SDR - V2.5 P2 - 4/17/02 - NOIS LUA-0102-160077 - Modified so it wouldn't kick user out after immediately
  1.  ;    editing one line for box 24,32, and 33.  It now asks if you would like to edit another line.
  1.  ;IHS/SD/SDR - V2.5 P2 - 4/17/02 - NOIS NCA-1001-180096 - Modified to correct so block 53 would print correct info
  1.  ;IHS/SD/SDR - v2.5 p8 - task 8 - Added code to correct add/edit prompt for FL override
  1.  ;IHS/SD/SDR - v2.5 p13 - IM25365 - Added FL 32a/32b/33a/33b for export mode 27
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*13 - Added check for new export mode 35
  1.  ;IHS/SD/AML - 2.6*21 - HEAT132667 - Changed code to use AUTNINS for lookup so identifiers will display when selecting
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT284071 - Added override option,fields for ADA-2012
  1.  ;
  1. START ;start
  1.  K DIC
  1.  W !
  1.  D INS Q:'$G(ABMINS)
  1.  D FORM Q:'$G(ABMFORM)
  1.  D BOX Q:'$G(ABMBOX)
  1.  D VTYP Q:'$G(ABMVTYP)
  1. STARTA K ABMLINE,ABMPIECE,ABMNM D @ABMBOX
  1.  Q:'$G(ABMLINE)
  1.  S ABMNM="FM"_ABMFORM_" "_ABMNM_" "_ABMVTYP
  1.  S:ABMVTYP=9999 ABMVTYP=""
  1.  D FILE
  1.  K ABMINS,ABMFORM,ABMBOX,ABMLINE,ABMPIECE,ABMANS,ABMDA,ABMEXIST,ABMVTYP
  1.  Q
  1. FORM ;select form
  1.  S DIC="^ABMDEXP(",DIC(0)="AEMQ"
  1.  ;S DIC("S")="I +Y=3!(+Y=14)!(+Y=27)"  ;abm*2.6*13 export mode 35
  1.  ;S DIC("S")="I +Y=3!(+Y=14)!(+Y=27)!(+Y=35)"  ;abm*2.6*13 export mode 35  ;abm*2.6*21 IHS/SD/SDR HEAT284071
  1.  S DIC("S")="I +Y=3!(+Y=14)!(+Y=27)!(+Y=35)!(+Y=34)"  ;abm*2.6*21 IHS/SD/SDR HEAT284071
  1.  D ^DIC K DIC
  1.  Q:+Y<0
  1.  S ABMFORM=+Y
  1.  Q
  1. INS ;select insurer
  1.  ;S DIC="^ABMNINS(DUZ(2),"  ;abm*2.6*21 IHS/SD/AML HEAT132667
  1.  S DIC="^AUTNINS("  ;abm*2.6*21 IHS/SD/AML HEAT132667
  1.  S DIC(0)="AEMQ"
  1.  D ^DIC Q:+Y<0
  1.  S ABMINS=+Y
  1.  Q
  1. BOX ;select form locator
  1.  S DIR(0)="S^10:RESERVED FOR LOCAL USE;11:BOX 11C - INSURANCE PLAN/PROGRAM NAME;19:RESERVED FOR LOCAL USE;24:LINE ITEMS;241:LINE 24, LINE 1 ITEM;32:WHERE SERVICES RENDERED;33:BILLING INFO"
  1.  ;start new abm*2.6*10 HEAT64983
  1.  I ABMFORM'=3  S DIR(0)="S^10:RESERVED FOR LOCAL USE;11:BOX 11C - INSURANCE PLAN/PROGRAM NAME;19:RESERVED FOR LOCAL USE;24:LINE ITEMS;241:LINE 24, LINE 1 ITEM;31:SIGNATURE OF PHYSICIAN;32:WHERE SERVICES RENDERED;33:BILLING INFO"
  1.  I ABMFORM=34 D
  1.  .S DIR(0)="S^16:PLAN/GROUP NUMBER;38:PLACE OF SERVICE;48:BILLING DENTIST OR DENTAL ENTITY ADDRESS;"
  1.  .S DIR(0)=DIR(0)_"49:BILLING DENTIST NPI;50:BILLING DENTIST LICENSE NUMBER;51:SSN/TIN;52:PHONE NUMBER or ADD'L PROVIDER ID;"
  1.  .S DIR(0)=DIR(0)_"53:TREATING DENTIST/LOCATION;54:NPI;55:TREATING DENTIST LICENSE NUMBER;56:TREATING DENTIST ADDRESS or PROVIDER SPECIALTY CODE;57:PHONE NUMBER;58:ADD'L PROVIDER ID"
  1.  S DIR("A")="Select Form Locator"
  1.  ;end new HEAT64983
  1.  D ^DIR K DIR
  1.  Q:'+Y
  1.  S ABMBOX=+Y
  1.  Q
  1. VTYP ;select visit type
  1.  S DIC="^ABMDVTYP("
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Enter visit type, or leave blank for all. "
  1.  D ^DIC
  1.  I X="" D
  1.  .S Y=9999
  1.  .W "ALL"
  1.  Q:+Y<0
  1.  S ABMVTYP=+Y
  1.  Q
  1. FILE ;file in 3P Insurer file
  1.  S ABMEXIST=$G(^ABMNINS(DUZ(2),ABMINS,2,"AOVR",ABMFORM,ABMLINE,ABMPIECE,+ABMVTYP)) D
  1.  .Q:ABMEXIST=""
  1.  .W !!,"Current Value: ",ABMEXIST
  1.  .W !,"Visit Type: ",$S(ABMVTYP="":"ALL",1:ABMVTYP)
  1.  I ABMLINE=37,(ABMPIECE=1!(ABMPIECE=2)) W !!?5,"Be sure to enter date in FM format (3071218 for 12/18/07)",!
  1.  S DA(1)=ABMINS
  1.  S:'$D(^ABMNINS(DUZ(2),DA(1),2,0)) ^(0)="^9002274.092^^"
  1.  S DIC="^ABMNINS(DUZ(2),DA(1),2,"
  1.  S X=ABMNM
  1.  S DIC(0)="LXE" D ^DIC
  1.  Q:+Y<0
  1.  S DA=+Y
  1.  S ABMDA=DA
  1.  S DIE=DIC
  1.  I $P(Y,U,3)'=1 D
  1.  .S DIR(0)="S^1:ADD/EDIT;2:DELETE"
  1.  .S DIR("A")="Add or Delete Entry?"
  1.  .S DIR("B")="ADD/EDIT"
  1.  .D ^DIR K DIR
  1.  .Q:'Y  S ABMANS=Y
  1.  E  S ABMANS=1
  1.  S:ABMANS=1 DR=".02///"_ABMFORM_";.03///"_ABMLINE_";.04///"_ABMPIECE_";.045///"_ABMVTYP_";.05"
  1.  S:ABMANS=2 DR=".01///@"
  1.  D ^DIE
  1.  I ABMANS=2 D
  1.  .W !,"Entry Deleted.",!
  1.  .D EOP^ABMDUTL(1)
  1.  ;I ABMNM["BOX 32"!(ABMNM["BOX 33")!(ABMNM["BOX 24") D  ;abm*2.6*10 HEAT64983
  1.  ;I ABMNM["BOX 31"!(ABMNM["BOX 32")!(ABMNM["BOX 33")!(ABMNM["BOX 24") D  ;abm*2.6*10 HEAT64983  ;abm*2.6*21 IHS/SD/SDR HEAT284071
  1.  I ABMNM["BOX 31"!(ABMNM["BOX 32")!(ABMNM["BOX 33")!(ABMNM["BOX 24")!(ABMNM["BOX 48")!(ABMNM["BOX 56") D  ;abm*2.6*10 HEAT64983  ;abm*2.6*21 IHS/SD/SDR HEAT284071
  1.  .K DIR
  1.  .S DIR(0)="Y"
  1.  .S DIR("A")="EDIT ANOTHER LINE?"
  1.  .S DIR("B")="N"
  1.  .D ^DIR
  1.  .K DIR
  1.  .I Y=1 G STARTA
  1.  Q
  1. 10 ;1500 locator 10d
  1.  S ABMLINE=19
  1.  S ABMPIECE=2
  1.  S ABMNM="BOX 10D LOCAL USE"
  1.  Q
  1. 11 ;1500 locator 11C
  1.  S ABMLINE=17
  1.  S ABMPIECE=4
  1.  S ABMNM="BOX 11C"
  1.  Q
  1. 19 ;1500 locator 19
  1.  S ABMLINE=29
  1.  S ABMPIECE=1
  1.  S ABMNM="BOX 19 LOCAL USE"
  1.  Q
  1. 24 ;1500 locator 24
  1.  K DIR
  1.  S DIR(0)="S^1:A1 - DOS FROM;2:A2 - DOS TO;3:B - POS;4:C - TOS;5:D - HCPCS;6:E - DIAGNOSIS;7:F - CHARGE;8:G - UNITS;9:H - EPSDT;10:I - EMG;11:J - COB;12:K - LOCAL USE"
  1.  ;S:ABMFORM=27 DIR(0)="S^1:A1 - DOS FROM;2:A2 - DOS TO;3:B - POS;4:C - EMG;5:D - HCPCS;6:E - DIAGNOSIS;7:F - CHARGE;8:G - UNITS;9:H - EPSDT;10:I - QUALIFIER;11:J - PROVIDER#"  ;abm*2.6*13 export mode 35
  1.  S:ABMFORM=27!(ABMFORM=35) DIR(0)="S^1:A1 - DOS FROM;2:A2 - DOS TO;3:B - POS;4:C - EMG;5:D - HCPCS;6:E - DIAGNOSIS;7:F - CHARGE;8:G - UNITS;9:H - EPSDT;10:I - QUALIFIER;11:J - PROVIDER#"  ;abm*2.6*13 export mode 35
  1.  S DIR("A")="Which Section?"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=37
  1.  S ABMPIECE=+Y
  1.  S ABMNM="BOX 24 "_$S($G(Y(0)):Y(0),1:Y)
  1.  Q
  1. 241 ;1500 location 24, line 1
  1.  ;IHS/SD/AML 7/18/2012 - Begin new code - Allow correct override for Shaded line in Box 24
  1.  K DIR
  1.  S DIR(0)="S^1:PIECE 1 - FREE TEXT;2:I - ID QUALIFIER;3:J - IDENTIFIER"
  1.  S DIR("A")="Which Section?"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=36
  1.  S ABMPIECE=+Y
  1.  S ABMNM="BOX 24, Line 1 "_$S($G(Y(0)):Y(0),1:Y)
  1.  ;IHS/SD/AML 7/18/2012 - End new code, begin old code
  1.  ;S ABMLINE=36
  1.  ;S ABMPIECE=3
  1.  ;S ABMNM="BOX 24, Line 1"
  1.  ;IHS/SD/AML 7/18/2012 - End old code
  1.  Q
  1.  ;start new code abm*2.6*10 HEAT64983
  1. 31 ;1500 locator 31
  1.  K DIR
  1.  S DIR(0)="S^1:LINE 1;2:LINE 2"
  1.  S DIR("A")="Enter Line Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=+Y+51
  1.  S ABMPIECE=1
  1.  S ABMNM="BOX 31 "_$S($G(Y(0)):Y(0),1:Y)
  1.  Q
  1.  ;end new code HEAT64983
  1. 32 ;1500 locator 32
  1.  K DIR
  1.  S DIR(0)="N^1:4"
  1.  ;I ABMFORM=27 S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3;4:LINE 4 32A;5:LINE 4 32B"  ;abm*2.6*13 export mode 35
  1.  I ABMFORM=27!(ABMFORM=35) S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3;4:LINE 4 32A;5:LINE 4 32B"  ;abm*2.6*13 export mode 35
  1.  S DIR("A")="Enter Line Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=+Y+50
  1.  S ABMPIECE=Y
  1.  I ABMLINE=53 S ABMPIECE=ABMPIECE-1
  1.  I +Y=4 S ABMPIECE=1,ABMLINE=54
  1.  I +Y=5 S ABMPIECE=2,ABMLINE=54
  1.  S ABMNM="BOX 32 "_$S($G(Y(0)):Y(0),1:Y)
  1.  Q
  1. 33 ;1500 locator 33
  1.  K DIR
  1.  S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3;4:LINE 4 PIN#;5:LINE 4 GRP#"
  1.  ;I ABMFORM=27 S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3;4:LINE 4 33A;5:LINE 4 33B"  ;abm*2.6*13 export mode 35
  1.  I ABMFORM=27!(ABMFORM=35) S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3;4:LINE 4 33A;5:LINE 4 33B"  ;abm*2.6*13 export mode 35
  1.  S DIR("A")="Enter Line Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=+Y+50
  1.  S ABMPIECE=$S(ABMLINE=51:2,1:3)
  1.  I +Y=5 S ABMPIECE=4,ABMLINE=54
  1.  S ABMNM="BOX 33 "_$S($G(Y(0)):Y(0),1:Y)
  1.  Q
  1.  ;start new abm*2.6*21 IHS/SD/SDR HEAT284071
  1. 16 ;ADA-2012 locator 16
  1.  S ABMLINE=12
  1.  S ABMPIECE=3
  1.  S ABMNM="BOX 16"
  1.  Q
  1. 38 ;ADA-2012 locator 38
  1.  S ABMLINE=42
  1.  S ABMPIECE=1
  1.  S ABMNM="BOX 38"
  1.  Q
  1. 48 ;ADA-2012 locator 48
  1.  K DIR
  1.  S DIR(0)="N^1:3"
  1.  S DIR(0)="S^1:LINE 1;2:LINE 2;3:LINE 3"
  1.  S DIR("A")="Enter Line Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=+Y+53
  1.  S ABMPIECE=1
  1.  S ABMNM="BOX 48 "_$S($G(Y(0)):Y(0),1:Y)
  1.  Q
  1. 49 ;ADA-2012 locator 49
  1.  S ABMLINE=59
  1.  S ABMPIECE=1
  1.  S ABMNM="BOX 49"
  1.  Q
  1. 50 ;ADA-2012 locator 50
  1.  S ABMLINE=59
  1.  S ABMPIECE=2
  1.  S ABMNM="BOX 50"
  1.  Q
  1. 51 ;ADA-2012 locator 51
  1.  S ABMLINE=59
  1.  S ABMPIECE=3
  1.  S ABMNM="BOX 51"
  1.  Q
  1. 52 ;ADA-2012 locator 52 and 52A
  1.  K DIR
  1.  S DIR(0)="N^1:2"
  1.  S DIR(0)="S^1:52 PHONE NUMBER;2:52A ADDITIONAL PROVIDER ID"
  1.  S DIR("A")="Enter Line Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=60
  1.  S ABMPIECE=+Y
  1.  S ABMNM="BOX 52"_$S(Y=2:"A",1:"")
  1.  Q
  1. 53 ;ADA-2012 locator 53
  1.  S ABMLINE=54
  1.  S ABMPIECE=2
  1.  S ABMNM="BOX 53"
  1.  Q
  1. 54 ;ADA-2012 locator 54
  1.  S ABMLINE=56
  1.  S ABMPIECE=2
  1.  S ABMNM="BOX 54"
  1.  Q
  1. 55 ;ADA-2012 locator 55
  1.  S ABMLINE=56
  1.  S ABMPIECE=3
  1.  S ABMNM="BOX 55"
  1.  Q
  1. 56 ;ADA-2012 locator 56
  1.  K DIR
  1.  S DIR(0)="N^1:3"
  1.  S DIR(0)="S^1:56 ADDRESS LINE 1;2:56 ADDRESS LINE 2;3:56A PROVIDER SPECIALTY CODE"
  1.  S DIR("A")="Enter Number"
  1.  D ^DIR K DIR
  1.  Q:'Y
  1.  S ABMLINE=$S(Y=2:59,Y=3:57,1:58)
  1.  S ABMPIECE=1
  1.  I ABMLINE=59 S ABMPIECE=4
  1.  S ABMNM="BOX 56"_$S(Y=3:"A",1:" LINE "_Y)
  1.  Q
  1. 57 ;ADA-2012 locator 57
  1.  S ABMLINE=60
  1.  S ABMPIECE=3
  1.  S ABMNM="BOX 57"
  1.  Q
  1. 58 ;ADA-2012 locator 58
  1.  S ABMLINE=60
  1.  S ABMPIECE=4
  1.  S ABMNM="BOX 58"
  1.  Q
  1.  ;end new abm*2.6*21 IHS/SD/SDR HEAT284071