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

ABMDF51X.m

Go to the documentation of this file. 
  1. ABMDF51X ;IHS/DSD/DMJ/LSL - PRINT UB92       
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM18516
  1.  ;    Added code to populate FL31 with Delayed Reason Code
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM20000
  1.  ;   Added code to look at CARD NAME for Policy Holder
  1.  ;
  1.  K ABM
  1.  S ABMP("LM")=$P(^ABMDEXP(11,0),"^",2)  ; Left margin of form
  1.  ;
  1.  ; FOLLOWING LINE TAGS CORRESPOND TO LINE NUMBERS
  1.  ;
  1. 1 ; EP
  1.  ; Provider name -- form locator #1
  1.  W !
  1.  S ABMP("NOFMT")=1  ; format flag (1 = no special formatting)
  1.  D 120^ABMER10      ; Provider name
  1.  S ABMDE=ABMR(10,120)_"^^25"  ; data ^ tab ^ format
  1.  D WRT^ABMDF11W     ; write data in specified format
  1.  ;
  1. 2 ;
  1.  ; Provider address, Patient control number, Bill type
  1.  W !
  1.  D 130^ABMER10      ; Provider address -- form locator #1
  1.  D 30^ABMER20       ; Patient control number -- form locator #3
  1.  S ABMDE=ABMR(10,130)_"^^25"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(20,30)_"^57^20"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMP("BTYP")_"^"_$S($G(IOM)=80:77,1:78)_"^3"  ; Bill type -- form locator #4 
  1.  D WRT^ABMDF11W
  1.  ;
  1. 3 ;
  1.  ; Provider city, state, zip  -- form locator #1
  1.  W !
  1.  D 140^ABMER10      ; Provider city
  1.  D 150^ABMER10      ; Provider state
  1.  D 160^ABMER10      ; Provider zip
  1.  I $L(ABMR(10,160))=9 D
  1.  .S ABMR(10,160)=$E(ABMR(10,160),1,5)_"-"_$E(ABMR(10,160),6,9)
  1.  .Q
  1.  S ABMDE=ABMR(10,140)_", "_ABMR(10,150)_" "_ABMR(10,160)_"^^25"
  1.  D WRT^ABMDF11W
  1.  ;
  1. 4 ;
  1.  W !
  1.  D 110^ABMER10      ; Provider phone          -- form locator #1
  1.  D 40^ABMER10       ; Fed. tax number         -- form locator #5
  1.  D 190^ABMER20      ; Stmt covers period from -- form locator #6
  1.  D 200^ABMER20      ; Stmt covers period to   -- form locator #6
  1.  D 200^ABMER30      ; Covered days            -- form locator #7
  1.  D 210^ABMER30      ; Non-covered days        -- form locator #8
  1.  D 220^ABMER30      ; Co-insured days         -- form locator #9
  1.  D 230^ABMER30      ; Lifetime reserve days   -- form locator #10
  1.  S ABMDE=ABMR(10,110)_"^^25"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(10,40)_"^26^10"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(20,190)_"^37^6"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(20,200)_"^44^6"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(30,200)_"^51^3R"
  1.  D:ABMR(30,200) WRT^ABMDF11W
  1.  S ABMDE=ABMR(30,210)_"^55^4R"
  1.  D:ABMR(30,210) WRT^ABMDF11W
  1.  S ABMDE=ABMR(30,220)_"^60^3R"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(30,230)_"^64^3R"
  1.  D WRT^ABMDF11W
  1.  ;
  1. 6 ;
  1.  ; Patient's name and mailing address
  1.  W !!
  1.  K ABMP("PNAME")
  1.  N I
  1.  F I=40:10:60 D     ; Patient name            -- form locator #12
  1.  .D @(I_"^ABMER20A")
  1.  N I
  1.  F I=120:10:160 D   ; Patient mailing address -- form locator #13
  1.  .D @(I_"^ABMER20")
  1.  I $L(ABMR(20,160))=9 D
  1.  .S ABMR(20,160)=$E(ABMR(20,160),1,5)_"-"_$E(ABMR(20,160),6,9)
  1.  .Q
  1.  S ABMP("PNAME")=ABMR(20,40)_", "_ABMR(20,50)_" "_ABMR(20,60)
  1.  S ABMDE=ABMP("PNAME")_"^^30"
  1.  D WRT^ABMDF11W
  1.  S ABMDE=ABMR(20,120)_$S(ABMR(20,130)]"":" "_ABMR(20,130),1:"")_", "_ABMR(20,140)_", "_ABMR(20,150)_" "_ABMR(20,160)_"^31^50"
  1.  D WRT^ABMDF11W
  1.  S ABMP("NOFMT")=0
  1.  ; Quit if printing additional pages to ONE itemized UB-92 claim
  1.  Q:$G(ABMORE)
  1.  ;
  1. 8 ;
  1.  W !!
  1.  K ABMR
  1.  N I
  1.  F I=70:10:110 D
  1.  .D @(I_"^ABMER20A")
  1.  N I
  1.  F I=170,180,210,220,250 D
  1.  .D @(I_"^ABMER20")
  1.  N I
  1.  F I=40:10:100 D
  1.  .D @(I_"^ABMER41A")
  1.  S ABMDE=ABMR(20,80)_"^^8"                   ; Patient Birthdate
  1.  D WRT^ABMDF11W                                  ; form locator #14
  1.  S ABMDE=ABMR(20,70)_"^9^1"                  ; Patient sex code
  1.  D WRT^ABMDF11W                                  ; form locator #15
  1.  S ABMDE=ABMR(20,90)_"^12^1"                 ; Marital Status code
  1.  D WRT^ABMDF11W                                  ; form locator #16
  1.  S:ABMR(20,170) ABMDE=ABMR(20,170)_"^14^6"   ; Admission date
  1.  D WRT^ABMDF11W                                  ; form locator #17
  1.  S:ABMR(20,180) ABMDE=ABMR(20,180)_"^21^2"   ; Admission hour
  1.  D WRT^ABMDF11W                                  ; form locator #18
  1.  S ABMDE=ABMR(20,100)_"^25^1"                ; Type of admission
  1.  D WRT^ABMDF11W                                  ; form locator #19
  1.  S ABMDE=ABMR(20,110)_"^28^1"                ; Source of admission
  1.  D WRT^ABMDF11W                                  ; form locator #20
  1.  S:ABMR(20,220) ABMDE=ABMR(20,220)_"^30^2"   ; Discharge hour
  1.  D WRT^ABMDF11W                                  ; form locator #21
  1.  S:ABMR(20,210) ABMDE=ABMR(20,210)_"^33^2"   ; Pat discharge status
  1.  D WRT^ABMDF11W                                  ; form locator #22
  1.  S ABMDE=ABMR(20,250)_"^36^17"               ; Medical record num.
  1.  D WRT^ABMDF11W                                  ; form locator #23
  1.  S ABMDE=ABMR(41,40)_"^54^2"                 ; Condition code - 1
  1.  D WRT^ABMDF11W                                  ; form locator #24
  1.  S ABMDE=ABMR(41,50)_"^57^2"                 ; Condition code - 2
  1.  D WRT^ABMDF11W                                  ; form locator #25
  1.  S ABMDE=ABMR(41,60)_"^60^2"                 ; Condition code - 3
  1.  D WRT^ABMDF11W                                  ; form locator #26
  1.  S ABMDE=ABMR(41,70)_"^63^2"                 ; Condition code - 4
  1.  D WRT^ABMDF11W                                  ; form locator #27 
  1.  S ABMDE=ABMR(41,80)_"^66^2"                 ; Condition code - 5
  1.  D WRT^ABMDF11W                                  ; form locator #28
  1.  S ABMDE=ABMR(41,90)_"^69^2"                 ; Condition code - 6
  1.  D WRT^ABMDF11W                                  ; form locator #29
  1.  S ABMDE=ABMR(41,100)_"^72^2"                ; Condition code - 7
  1.  D WRT^ABMDF11W                                  ; form locator #30
  1.  ;
  1.  S ABMDRC=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",16)  ;delayed reason code
  1.  I ABMDRC D
  1.  .S ABMDRC=$P($G(^ABMDCODE(ABMDRC,0)),"^")
  1.  .S ABMDE=ABMDRC_"^76^2"
  1.  .D WRT^ABMDF11W  ;form locator #31
  1. 10 ;
  1.  W !!
  1.  K ABMR
  1.  N I
  1.  F I=80:10:150 D
  1.  .D @(I_"^ABMER40A")
  1.  N I
  1.  F I=280:10:300 D
  1.  .D @(I_"^ABMER40")
  1.  S ABMDE=ABMR(40,80)_"^^2"              ; Occurrence code - 1
  1.  D WRT^ABMDF11W                             ; form locator #32a
  1.  S ABMDE=ABMR(40,90)_"^3^6"             ; Occurrence date - 1
  1.  D WRT^ABMDF11W                             ; form locator #32a
  1.  S ABMDE=ABMR(40,100)_"^10^2"           ; Occurrence code - 2
  1.  D WRT^ABMDF11W                             ; form locator #33a
  1.  S ABMDE=ABMR(40,110)_"^13^6"           ; Occurrence date - 2
  1.  D WRT^ABMDF11W                             ; form locator #33a
  1.  S ABMDE=ABMR(40,120)_"^20^2"           ; Occurrence code - 3
  1.  D WRT^ABMDF11W                             ; form locator #34a
  1.  S ABMDE=ABMR(40,130)_"^23^6"           ; Occurrence date - 3
  1.  D WRT^ABMDF11W                             ; form locator #34a
  1.  S ABMDE=ABMR(40,140)_"^30^2"           ; Occurrence code - 4
  1.  D WRT^ABMDF11W                             ; form locator #35a
  1.  S ABMDE=ABMR(40,150)_"^33^6"           ; Occurrence date - 4
  1.  D WRT^ABMDF11W                             ; form locator #35a
  1.  S ABMDE=ABMR(40,280)_"^40^2"           ; Occur. Span code - 1
  1.  D WRT^ABMDF11W                             ; form locator #36a
  1.  S ABMDE=ABMR(40,290)_"^43^6"           ; Occur. Span from date - 1
  1.  D WRT^ABMDF11W                             ; form locator #36a
  1.  S ABMDE=ABMR(40,300)_"^50^6"           ; Occur. Span thru date - 1
  1.  D WRT^ABMDF11W                             ; form locator #36a
  1.  ;
  1. 11 ;
  1.  W !
  1.  K ABMR
  1.  N I
  1.  F I=160,170 D
  1.  .D @(I_"^ABMER40A")
  1.  N I
  1.  F I=180:10:230,310:10:330 D
  1.  .D @(I_"^ABMER40")
  1.  S ABMDE=ABMR(40,160)_"^^2"             ; Occurrence code - 5
  1.  D WRT^ABMDF11W                             ; form locator #32b
  1.  S ABMDE=ABMR(40,170)_"^3^6"            ; Occurrence date - 5
  1.  D WRT^ABMDF11W                             ; form locator #32b
  1.  S ABMDE=ABMR(40,180)_"^10^2"           ; Occurrence code - 6
  1.  D WRT^ABMDF11W                             ; form locator #33b
  1.  S ABMDE=ABMR(40,190)_"^13^6"           ; Occurrence date - 6
  1.  D WRT^ABMDF11W                             ; form locator #33b
  1.  S ABMDE=ABMR(40,200)_"^20^2"           ; Occurrence code - 7
  1.  D WRT^ABMDF11W                             ; form locator #34b
  1.  S ABMDE=ABMR(40,210)_"^23^6"           ; Occurrence date - 7
  1.  D WRT^ABMDF11W                             ; form locator #34b
  1.  S ABMDE=ABMR(40,220)_"^30^2"           ; Occurrence code - 8
  1.  D WRT^ABMDF11W                             ; form locator #35b
  1.  S ABMDE=ABMR(40,230)_"^33^6"           ; Occurrence date - 8
  1.  D WRT^ABMDF11W                             ; form locator #35b
  1.  S ABMDE=ABMR(40,310)_"^40^2"           ; Occur. Span code - 2
  1.  D WRT^ABMDF11W                             ; form locator #36b
  1.  S ABMDE=ABMR(40,320)_"^43^6"           ; Occur. Span from date - 2
  1.  D WRT^ABMDF11W                             ; form locator #36b
  1.  S ABMDE=ABMR(40,330)_"^50^6"           ; Occur. Span thru date - 2
  1.  D WRT^ABMDF11W                             ; form locator #36b
  1.  ;
  1. 12 ;
  1.  ; If private insurance and relationship of policy holder to patient
  1.  ; is not self, write name of policy holder
  1.  W !
  1.  I ABMP("ITYPE")="P" D
  1.  .N I
  1.  .S I=0
  1.  .F  S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I  D  ; Insurer
  1.  ..; Insurer status = Initiated
  1.  ..I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),"^",3)="I" S ABME("INS")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U),ABME("INSIEN")=I
  1.  .Q:'$G(ABME("INSIEN"))
  1.  .D PRVT^ABMERINS
  1.  .S ABMDE=$G(ABM(9000003.1,+$G(ABME("PH")),2,"E"))_"^^40"  ;card name-policy holder
  1.  .S:($P(ABMDE,U)="") $P(ABMDE,U)=$G(ABM(9000003.1,+$G(ABME("PH")),.01,"E"))_"^^40"  ;name-policy holder
  1.  .D WRT^ABMDF11W                    ; form locator #38
  1.  .Q
  1.  ;
  1. OTHER ;DO OTHER ROUTINES & QUIT
  1.  D ^ABMDF51Y,^ABMDF51Z
  1.  W $$EN^ABMVDF("IOF")
  1.  K ABMR,ABMREC,ABM,ABME
  1.  Q
  1.  ;
  1. TEST ;
  1.  ; EP;Test forms allignment
  1.  D TEST^ABMDF11W
  1.  Q