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

ABMDF27X.m

Go to the documentation of this file. 
  1. ABMDF27X ; IHS/ASDST/DMJ - New HCFA-1500 (08/05) Format ;   
  1.  ;;2.6;IHS Third Party Billing;**1,3,4,8,9,10,11,13,21**;NOV 12, 2009;Build 379
  1.  ;
  1.  ; Objective: Print designated form using data contained in the
  1.  ;            ABMF array.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM25017 - Changes for 1st line of block 24J provider number
  1.  ; IHS/SD/SDR - v2.5 p12 - IM25331 - Put taxonomy code if NPI ONLY
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24829 - Make 24a 2-digit rather than 4 and TO format
  1.  ; IHS/SD/SDR - v2.5 p13 - IM25899 - Alignment changes
  1.  ; IHS/SD/SDR - v2.5 p13 - IM25365 - Changed for FL override
  1.  ; IHS/SD/SDR - abm*2.6*1 - HEAT3077 - Change FL override to remove NPI from 24I
  1.  ; IHS/SD/SDR - abm*2.6*3 - HEAT11389 - made correction to OVER to check line number
  1.  ; IHS/SD/SDR - abm*2.6*4  HEAT12115 - allow 5+ DX codes
  1.  ; IHS/SD/SDR - 2.6*9 - fixed FL override to use LDFN not DUZ(2)
  1.  ;IHS/SD/SDR - 2.6*13 - HEAT117086 - changed it so T1015 will be top line for any D insurer type
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT205579 - Made T1015 print on first line for ARBOR HEALTH PLAN
  1.  ;IHS/SD/SDR - 2.6*21 - NOHEAT1 - Fix for <UNDEF>LOOP+29^ABMDF27X
  1.  ;
  1.  ;
  1. MARG ;Set left and top margins
  1.  S (ABM("LM"),ABM("TM"),ABM("LN"))=0
  1.  I $G(IOT)'="HFS" S ABM("TM")=$P(^ABMDEXP(27,0),U,3),ABM("LM")=$P(^(0),U,2)
  1.  W $$EN^ABMVDF("IOF")
  1.  I +ABM("TM") F ABM("I")=1:1:ABM("TM") W !
  1.  D:$G(ABMP("INS")) OVER
  1.  ;
  1. LOOP ;Loop thru line number array
  1.  S ABM("LN")=$O(ABMF(ABM("LN"))) I +ABM("LN")=0!(ABM("LN")>56) G XIT
  1.  ;
  1.  ;Check for invalid line numbers
  1.  F ABM("I")=2,4,6,8,10,12,14,16,18,20,21,22,24,28,30,32,34,35,48,55,56,57 I ABM("LN")=ABM("I") Q
  1.  I  G LOOP
  1.  ;
  1.  ;Set to correct format line
  1.  S ABM("FL")=ABM("LN")
  1.  I ABM("LN")>35,(ABM("LN")<48),$L(ABMF(ABM("LN")),"^")<4 S ABM("FL")=36
  1.  I ABM("LN")>35,(ABM("LN")<48),$L(ABMF(ABM("LN")),"^")>3 S ABM("FL")=37
  1.  ;
  1.  ;Set tab & format variables
  1.  S ABM("TABS")=$P($T(@ABM("FL")),";;",2)
  1.  S ABM("FMAT")=$P($T(@ABM("FL")),";;",3)
  1.  ;
  1.  ;added NE Medicaid code for W0047 to print first
  1.  I $P(ABMF(17),U,4)["NEBRASKA MEDICAID",ABMP("VTYP")=131 D
  1.  .F ABMLOOP=37:2:47 D
  1.  ..Q:'$D(ABMF(ABMLOOP))
  1.  ..S ABMCHK=$TR($P(ABMF(ABMLOOP),U,5)," ","")
  1.  ..I ABMCHK["W0047",ABMLOOP'=37 D
  1.  ...S ABMF("TMP")=$G(ABMF(37))
  1.  ...S ABMF(37)=$G(ABMF(ABMLOOP))
  1.  ...S ABMF(ABMLOOP)=$G(ABMF("TMP"))
  1.  K ABMLOOP,ABMCHK,ABMF("TMP")
  1.  ;
  1.  ;start new code abm*2.6*11 HEAT97421
  1.  ;I $P(ABMF(17),U,4)["IOWA MEDICAID" D  ;abm*2.6*13 HEAT117086
  1.  ;I ABMP("ITYPE")="D" D  ;abm*2.6*13 HEAT117086  ;abm*2.6*21 IHS/SD/SDR NOHEAT1
  1.  I $G(ABMP("ITYPE"))="D"!($P($G(^AUTNINS(ABMP("INS"),0)),U)="ARBOR HEALTH PLAN") D  ;abm*2.6*13 HEAT117086  ;abm*2.6*21 IHS/SD/SDR NOHEAT1 and HEAT205579
  1.  .F ABMLOOP=37:2:47 D
  1.  ..Q:'$D(ABMF(ABMLOOP))
  1.  ..S ABMCHK=$TR($P(ABMF(ABMLOOP),U,5)," ","")
  1.  ..I ABMCHK["T1015",ABMLOOP'=37 D
  1.  ...S ABMF("TMP")=$G(ABMF(37))
  1.  ...S ABMF(37)=$G(ABMF(ABMLOOP))
  1.  ...S ABMF(ABMLOOP)=$G(ABMF("TMP"))
  1.  K ABMLOOP,ABMCHK,ABMF("TMP")
  1.  ;end new code HEAT97421
  1.  ;
  1.  ;Skip to req'd line
  1.  F  Q:$Y-ABM("TM")>(ABM("LN")+5)  W ! D
  1.  .Q:($Y-ABM("TM")<1)!($Y-ABM("TM")>5)
  1.  .Q:$D(ABMF("TEST"))
  1.  .I $Y-ABM("TM")=5 W ?1,"XXX",?32,"Page "_ABMPGCNT_" of "_ABMPGTOT,?76,"XXX" S ABMPGCNT=ABMPGCNT+1 Q
  1.  .Q:'$D(ABMP("INS"))  K ABM("INS")
  1.  .I ($Y-ABM("TM"))=1 D
  1.  ..S ABM("J")=ABMP("BDFN"),ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
  1.  ..S ABM("INS",ABM("I"),ABM("J"))=$S(ABM("I")["NON-BENEFICIARY PATIENT":$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),0),"^",5),1:"")
  1.  ..D BADDR^ABMDLBL1
  1.  ..W ?34,"To: "
  1.  .Q:'$D(ABM("ADD"))
  1.  .W ?38,$E($P(ABM("ADD"),U,($Y-ABM("TM"))),1,39)
  1.  ;
  1.  ; Test Modes for setting Data Fields
  1.  G LOOP2:'$D(ABMF("TEST"))
  1.  F ABM("I")=1:1:$L(ABM("FMAT"),U) I $P(ABM("TABS"),U,ABM("I"))]"" S ABM("FLD")="",$P(ABM("FLD"),"X",$P(ABM("FMAT"),U,ABM("I"))+1)="" I ABM("FLD")]"" W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM")) D FRMT
  1.  G LOOP
  1.  ;
  1. LOOP2 ;Loop thru the pieces of the line array
  1.  F ABM("I")=1:1:$L(ABMF(ABM("LN")),U) D
  1.  .Q:'+$P(ABM("TABS"),U,ABM("I"))
  1.  .I ABM("LN")=29,(ABM("I")=4),ABMPGCNT>2 Q  ;abm*2.6*10 HEAT65976
  1.  .I ABM("LN")>30,(ABM("LN")<34),(ABM("I")<3),($P(ABMF(17),U,4)["MAINE MEDICAID") D
  1.  ..S $P(ABMF(ABM("LN")),U,ABM("I"))=$TR($P(ABMF(ABM("LN")),U,ABM("I")),".","")
  1.  .;if Maine Medicaid take commas of out box 24E
  1.  .I ABM("LN")>36,(ABM("LN")<48),(ABM("I")=6),($P(ABMF(17),U,4)["MAINE MEDICAID") D
  1.  ..S $P(ABMF(ABM("LN")),U,ABM("I"))=$TR($P(ABMF(ABM("LN")),U,ABM("I")),",","")
  1.  .S ABM("FLD")=$P(ABMF(ABM("LN")),U,ABM("I"))
  1.  .I $G(ABMP("PTOT"))'=1,($D(ABMP("MORE"))),(ABM("LN")=49),(ABM("I")=7!(ABM("I")=9)) S ABM("FLD")=$G(ABM("LTOT"))
  1.  .I ABM("FLD")]"" W ?($P(ABM("TABS"),U,ABM("I"))+ABM("LM")) D FRMT
  1.  .;Put "cont" in total charges box if multi page.
  1.  .I $D(ABMR("MORE")),ABM("LN")=49,ABM("I")=7,$G(ABMP("PTOT"))=1 W ?52,"(CONT.)"
  1.  G LOOP
  1.  ;
  1.  ;Write the field in the designated format
  1. FRMT S ABM("LTH")=$P(ABM("FMAT"),U,ABM("I")) I +ABM("LTH")=0 S ABM("LTH")=99
  1.  I $P(ABMF(17),U,4)="PHC MEDICAID",ABM("LTH")["$" S ABM("LTH")=$P(ABM("LTH"),"$") W $J($TR($FN(+ABM("FLD"),",",2),"."),ABM("LTH")) S:ABM("LN")'=49 ABM("LTOT")=+$G(ABM("LTOT"))+ABM("FLD") Q  ;abm*2.6*11 IHS/SD/AML HEAT30524 PARTNERSHIP MCD
  1.  ;I ABM("LTH")["$" S ABM("LTH")=$P(ABM("LTH"),"$") W $J($FN(+ABM("FLD"),",",2),ABM("LTH")) S:ABM("LN")'=49 ABM("LTOT")=+$G(ABM("LTOT"))+ABM("FLD") Q  ;abm*2.6*10 HEAT65976
  1.  I ABM("LTH")["$" S ABM("LTH")=$P(ABM("LTH"),"$") W $J($FN(+ABM("FLD"),",",2),ABM("LTH")) S:(ABM("LN")'=49&(ABM("LN")'=29)) ABM("LTOT")=+$G(ABM("LTOT"))+ABM("FLD") Q  ;abm*2.6*10 HEAT65976
  1.  ;if Maine Medicaid take spaces out of dates
  1.  I $P(ABMF(17),U,4)["MAINE MEDICAID",(ABM("LTH")["D") S ABM("LTH")=$P(ABM("LTH"),"D") W $E(ABM("FLD"),4,5),$E(ABM("FLD"),6,7),$E(ABM("FLD"),1,3)+1700 Q
  1.  I ABM("LTH")["T" S ABM("LTH")=$P(ABM("LTH"),"T") W $E(ABM("FLD"),4,5)," ",$E(ABM("FLD"),6,7)," ",$E(ABM("FLD"),2,3) Q
  1.  I ABM("LTH")["D" S ABM("LTH")=$P(ABM("LTH"),"D") W $E(ABM("FLD"),4,5)," ",$E(ABM("FLD"),6,7)," ",$E(ABM("FLD"),1,3)+1700 Q
  1.  I ABM("LTH")["Y" S ABM("LTH")=$P(ABM("LTH"),"Y") W $E(ABM("FLD"),4,7),$E(ABM("FLD"),1,3)+1700 Q
  1.  I ABM("LTH")["L" S ABM("LTH")=$P(ABM("LTH"),"L") F  Q:$L(ABM("FLD"))=ABM("LTH")!($L(ABM("FLD"))>ABM("LTH"))  S ABM("FLD")="0"_ABM("FLD")
  1.  I ABM("LTH")["C" S ABM("LTH")=$P(ABM("LTH"),"C") S ABM("FLD")=$J("",ABM("LTH")-$L(ABM("FLD"))\2)_ABM("FLD")
  1.  I ABM("LTH")["R" S ABM("LTH")=$P(ABM("LTH"),"R") S ABM("RT")=ABM("LTH")-$L(ABM("FLD"))+1 I ABM("RT")>1 S ABM("BLNK")="",$P(ABM("BLNK")," ",ABM("RT"))="",ABM("FLD")=ABM("BLNK")_ABM("FLD")
  1.  W $E(ABM("FLD"),1,ABM("LTH"))
  1.  Q
  1.  ;
  1. TEST S ABMF("TEST")=1
  1.  F ABM=0:ABMF("TEST"):60 S ABMF(ABM)=""
  1.  G MARG
  1.  ;
  1. OVER ;GET OVRRIDE VALUES FROM 3P INSURER FILE
  1.  ;S ABMOLN=0 F  S ABMOLN=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",27,ABMOLN)) Q:'ABMOLN  D  ;abm*2.6*9 HEAT51380
  1.  S ABMOLN=0 F  S ABMOLN=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",27,ABMOLN)) Q:'ABMOLN  D  ;abm*2.6*9 HEAT51380
  1.  .;S ABMOPC=0 F  S ABMOPC=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC)) Q:'ABMOPC  D  ;abm*2.6*9 HEAT51380
  1.  .S ABMOPC=0 F  S ABMOPC=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC)) Q:'ABMOPC  D  ;abm*2.6*9 HEAT51380
  1.  ..K ABMOVTYP
  1.  ..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,0)) S ABMOVTYP=0  ;abm*2.6*9 HEAT51380
  1.  ..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,0)) S ABMOVTYP=0  ;abm*2.6*9 HEAT51380
  1.  ..;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")  ;abm*2.6*9 HEAT51380
  1.  ..I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")  ;abm*2.6*9 HEAT51380
  1.  ..Q:'$D(ABMOVTYP)
  1.  ..;S ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,ABMOVTYP)  ;abm*2.6*9 HEAT51380
  1.  ..S ABMVALUE=^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",27,ABMOLN,ABMOPC,ABMOVTYP)  ;abm*2.6*9 HEAT51380
  1.  ..;I ABMOLN>35,ABMOLN<49 N I F I=36:2:47 D  ;abm*2.6*1 HEAT3077
  1.  ..;I ABMOLN>35,ABMOLN<49 N I F I=36:1:47 D  ;abm*2.6*1 HEAT3077  ;abm*2.6*10 HEAT64983
  1.  ..;I ABMOLN>35,ABMOLN<49 N I F I=36:1:47 D  Q  ;abm*2.6*1 HEAT3077  ;abm*2.6*10 HEAT64983  ;abm*2.6*11 HEAT104682
  1.  ..I ABMOLN>35,ABMOLN<49 N I F I=36:1:47 D  ;abm*2.6*11 HEAT104682
  1.  ...Q:'$D(ABMF(I))
  1.  ...Q:$L(ABMF(I),"^")<3
  1.  ...;Q:((ABMF(I)#2)'=(ABMOLN#2))  ;abm*2.6*3 HEAT11389
  1.  ...Q:((I#2)'=(ABMOLN#2))  ;abm*2.6*3 HEAT11389
  1.  ...S $P(ABMF(I),"^",ABMOPC)=ABMVALUE
  1.  ..;I ABMOLN>36,ABMOLN<49 Q  ;abm*2.6*10 HEAT64983
  1.  ..;S $P(ABMF(ABMOLN),"^",$S((ABMOLN=53):(ABMOPC-1),(ABMOLN=54):(ABMOPC+1),1:ABMOPC))=ABMVALUE  ;abm*2.6*10 HEAT64983
  1.  ..S $P(ABMF(ABMOLN),"^",$S((ABMOLN=53&ABMOPC=1):ABMOPC,(ABMOLN=53):(ABMOPC-1),(ABMOLN=54):(ABMOPC+1),1:ABMOPC))=ABMVALUE  ;abm*2.6*10 HEAT64983
  1.  K ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP
  1.  Q
  1. XIT K ABM
  1.  I '$D(ABMR("MORE")) K ABMF
  1.  Q
  1. TEXT ;;TABS;;FIELD LENGTH
  1.  ;            FORMAT ($-$ FORMAT,L-LNGTH REQ'D,C-CENTER,R-RIGHT,D-DATE)
  1. 1 ;;1^8^15^24^31^39^45^50;;1^1^1^1^1^1^1^29C
  1. 3 ;;1^31^42^47^50;;28^10D^1^1^29C
  1. 5 ;;1^33^38^42^47^50;;28^1^1^1^1^29C
  1. 7 ;;1^27^35^41^47^50^75;;24^3^1^1^1^23C^4
  1. 9 ;;1^14^35^41^47^50^64;;12^13^1^1^1^12C^13
  1. 11 ;;1^50;;28^29C
  1. 13 ;;1^35^41^53^68^75;;28^1^1^10D^1^1
  1. 15 ;;2^18^24^35^41^46^50;;10D^1^1^1^1^2^29C
  1. 17 ;;1^35^41^50;;28C^1^1^29C
  1. 19 ;;1^30^52^57;;28C^19C^1^1
  1. 23 ;;6^37^56;;24C^10D^23
  1. 25 ;;2^37^54^68;;10D^10D^10D^10D
  1. 26 ;;30;;19
  1. 27 ;;1^33^54^68;;26^10^10D^10D
  1. 29 ;;1^52^57^62;;48^1^1^8$
  1. 31 ;;3^13^29^38^50;;^10^10^9^10^29
  1.  ;;3^30^50;;25^19^29  ;abm*2.6*4 HEAT12115 original 31
  1. 33 ;;3^13^29^38^50;;^10^10^9^10^29C
  1.  ;;3^30^50;;25^19^29C  ;abm*2.6*4 HEAT12115 original 33
  1. 36 ;;1^65^68;;61^2^12
  1.  ;;1^63^65;;61^2^15  ;abm*2.6*8 HEAT14200 original 36
  1. 37 ;;1^10^19^22^23^45^50^59^63^65^68;;8T^8T^2R^1R^19^5^8$^4C^2R^2R^10 
  1.  ;;1^10^19^22^23^45^50^59^63^65^68;;8T^8T^2R^1R^19^7^8$^5R^2R^2R^10  ;abm*2.6*11 IHS/SD/AML HEAT97406 - Move Units to left
  1.  ;;1^10^19^22^23^45^50^59^63^65^68;;8T^8T^2R^1R^19^7^8$^3R^2R^2R^10  ;abm*2.6*10 HEAT60484 original line 37
  1. 49 ;;1^17^19^23^38^43^51^61^71;;15^1^1^14C^1^1^9$^8$^8$
  1. 50 ;;65;;14
  1. 51 ;;23^50;;26^29
  1. 52 ;;1^23^50;;21^26^29
  1. 53 ;;1^23^50;;21^26^29
  1.  ;;23^50;;26^29  ;original line 53 abm*2.6*10 HEAT64983
  1. 54 ;;12^23^33^50^62;;10D^10^14R^10C^17