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

ABMDF11Z.m

Go to the documentation of this file. 
  1. ABMDF11Z ; IHS/ASDST/DMJ - PRINT UB92 ;  
  1.  ;;2.6;IHS 3P BILLING SYSTEM;;NOV 12, 2009
  1.  ;Original;DMJ;
  1.  ;
  1.  ; IHS/ASDS/LSL - 04/05/00 - V2.4 Patch 1 - NOIS NCA-0300-180046
  1.  ;     Moved PROV to ABMDF11W because patching here would result in
  1.  ;     exceeding maximum routine size allowed.
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p9 - IM15561
  1.  ;    Only do state license number if not Medicare
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p10 - IM19557
  1.  ;   Correct due from patient
  1.  ;
  1.  ; IHS/SD/SDR - v2.5 p12 - IM24099
  1.  ;   Put CR/LF after quit in tag 47
  1.  ;   Removed extra - top of tag 51
  1.  ;
  1. 45 ;
  1.  ; ABMPAID = Primary + Secondary + Tertiary + Prepaid
  1.  ; ABMPBAL = Gross amount - ABM("PAID")
  1.  ; Form locator #57
  1.  W !
  1.  ; If non-ben patient
  1.  I ABMP("ITYPE")="N" D
  1.  .S ABMPRPAY=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9)),"^",9)
  1.  .S ABMPAID=+($E($G(ABMREC(30,1)),173,182)/100)+($E($G(ABMREC(30,2)),173,182)/100)+($E($G(ABMREC(30,3)),173,182)/100)+ABMPRPAY
  1.  .S:$G(ABMPBAL)<0 ABMPBAL=0
  1.  .S ABMDE=$TR($FN(ABMPAID,"T",2),".")_"^45^10R"
  1.  .D WRT^ABMDF11W                  ; Total paid
  1.  .S ABMDE=$TR($FN(ABMPBAL,"T",2),".")_"^56^10R"
  1.  .D WRT^ABMDF11W                  ; Remaining balance
  1.  ;
  1. 47 ;
  1.  W !
  1.  N I
  1.  F I=1:1:3 D
  1.  .Q:'$D(ABMREC(30,I))
  1.  .S ABMDE=$E(ABMREC(30,I),111,130)  ; Insured's last name
  1.  .S ABMDE=$TR(ABMDE," ")
  1.  .I $E(ABMREC(30,I),131,139)]"" S ABMDE=ABMDE_","_$TR($E(ABMREC(30,I),131,139)," ")   ; Add First Name
  1.  .I $E(ABMREC(30,I),140)]"" S ABMDE=ABMDE_" "_$E(ABMREC(30,I),140)   ; Add Middle Initial
  1.  .S ABMDE=ABMDE_"^^25"                  ; Insured's Name
  1.  .D WRT^ABMDF11W                                ; form locator #58
  1.  .S ABMDE=$E(ABMREC(30,I),144,145)_"^26^2"  ; Pat relation to Ins
  1.  .D WRT^ABMDF11W                                ; form locator #59
  1.  .S ABMDE=$E(ABMREC(30,I),35,53)_"^29^19"   ; Claim Certificate ID
  1.  .D WRT^ABMDF11W                                ; form locator #60
  1.  .S ABMDE=$E(ABMREC(30,I),97,110)_"^49^14"  ; Insured Group Name
  1.  .D WRT^ABMDF11W                                ; form locator #61
  1.  .S ABMDE=$E(ABMREC(30,I),80,96)_"^64^17"   ; Insurance Group Num
  1.  .D WRT^ABMDF11W                                ; Form locator #62
  1.  ;
  1. 51 ;
  1.  N I
  1.  F I=50:10:70 D
  1.  .D @(I_"^ABMER40A")
  1.  N I
  1.  F I=1:1:3 D
  1.  .W !
  1.  .Q:'$D(ABMREC(30,I))
  1.  .S ABMDE=ABMR(40,(10*I)+40)_"^^18"         ; Pro Authorization #
  1.  .D WRT^ABMDF11W                                ; form locator #63
  1.  .S ABMDE=$E(ABMREC(30,I),146)_"^19^1R"     ; Employmnt Status code
  1.  .D WRT^ABMDF11W                                ; form locator #64
  1.  .S ABMDE=$E(ABMREC(31,I),87,110)_"^21^24"  ; Employer name
  1.  .D WRT^ABMDF11W                                ; form locator #65
  1.  .S ABMTMPDE=$E(ABMREC(31,I),129,143)       ; Employer city, state
  1.  .S ABMDE=$P(ABMTMPDE," ",1)
  1.  .N J
  1.  .F J=2:1:$L(ABMTMPDE," ") D
  1.  ..I $P(ABMTMPDE," ",J)]"" S ABMDE=ABMDE_" "_$P(ABMTMPDE," ",J)
  1.  .I $E(ABMREC(31,I),144,145)'="  " S ABMDE=ABMDE_", "_$E(ABMREC(31,I),144,145)
  1.  .S ABMDE=ABMDE_"^46^35"                ; Employer location
  1.  .D WRT^ABMDF11W                                ; form locator #66
  1.  ;
  1. 55 ;
  1.  W !!
  1.  N I
  1.  F I=40:10:120 D
  1.  .D @(I_"^ABMER70A")
  1.  N I
  1.  F I=250,260 D
  1.  .D @(I_"^ABMER70")
  1.  S ABMDE=ABMR(70,40)_"^^6"       ; Principle Diagnosis
  1.  D WRT^ABMDF11W                      ; form locator #67
  1.  S ABMDE=ABMR(70,50)_"^7^6"      ; Other Diagnosis Code 1
  1.  D WRT^ABMDF11W                      ; form locator #68
  1.  S ABMDE=ABMR(70,60)_"^14^6"     ; Other Diagnosis Code 2
  1.  D WRT^ABMDF11W                      ; form locator #69
  1.  S ABMDE=ABMR(70,70)_"^21^6"     ; Other Diagnosis Code 3
  1.  D WRT^ABMDF11W                      ; form locator #70
  1.  S ABMDE=ABMR(70,80)_"^28^6"     ; Other Diagnosis Code 4
  1.  D WRT^ABMDF11W                      ; form locator #71
  1.  S ABMDE=ABMR(70,90)_"^35^6"     ; Other Diagnosis Code 5
  1.  D WRT^ABMDF11W                      ; form locator #72
  1.  S ABMDE=ABMR(70,100)_"^42^6"    ; Other Diagnosis Code 6
  1.  D WRT^ABMDF11W                      ; form locator #73
  1.  S ABMDE=ABMR(70,110)_"^49^6"    ; Other Diagnosis Code 7
  1.  D WRT^ABMDF11W                      ; form locator #74
  1.  S ABMDE=ABMR(70,120)_"^56^6"    ; Other Diagnosis Code 8
  1.  D WRT^ABMDF11W                      ; form locator #75
  1.  S ABMDE=ABMR(70,250)_"^64^6"    ; Admitting Diagnosis
  1.  D WRT^ABMDF11W                      ; form locator #76
  1.  S ABMDE=ABMR(70,260)_"^71^6"    ; External cause of injury
  1.  D WRT^ABMDF11W                      ; form locator #77
  1.  ;
  1. 56 ;
  1.  W !
  1.  D PROV^ABMDF11W
  1.  ; Primary Provider State Liscence #
  1.  I ABMP("ITYPE")'="R" D  ;only if not Medicare
  1.  .S ABMDE=$P($G(ABM("PRV",1)),"^",3)_"^59^23"
  1.  .D WRT^ABMDF11W  ;form locator #82a
  1.  ;
  1. 57 ;
  1.  W !
  1.  N I
  1.  F I=130:10:240,270 D
  1.  .D @(I_"^ABMER70")
  1.  S ABMDE=ABMR(70,270)_"^^1"      ; Procedure coding method used
  1.  D WRT^ABMDF11W                      ; form locator #79
  1.  I $P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,9)'="N" D
  1.  .D WRT^ABMDF11W                      ; form locator #79
  1.  .S ABMDE=ABMR(70,130)_"^3^7"     ; Principle Procedure code
  1.  .D WRT^ABMDF11W                      ; form locator #80a
  1.  .S ABMDE=ABMR(70,140)_"^11^6"    ; Principle Procedure date
  1.  .D WRT^ABMDF11W                      ; form locator #80b
  1.  .S ABMDE=ABMR(70,150)_"^18^7"    ; Other Procedure code - 1
  1.  .D WRT^ABMDF11W                      ; form locator #81a
  1.  .S ABMDE=ABMR(70,160)_"^26^6"    ; Other Procedure date - 1
  1.  .D WRT^ABMDF11W                      ; form locator #81b
  1.  .S ABMDE=ABMR(70,170)_"^33^7"    ; Other Procedure code - 2
  1.  .D WRT^ABMDF11W                      ; form locator #81c
  1.  .S ABMDE=ABMR(70,180)_"^41^6"    ; Other Procedure date - 2
  1.  .D WRT^ABMDF11W                      ; form locator #81d
  1.  ; Primary Provider UPIN/MCD #_name
  1.  S ABMDE=$P($G(ABM("PRV",1)),"^",1)_"^49^32"
  1.  D WRT^ABMDF11W                      ; form locator #82b
  1.  ;
  1. 58 ;
  1.  ; Secondary Provider Liscence #
  1.  W !
  1.  S ABMDE=$P($G(ABM("PRV",2)),"^",3)_"^59^23"
  1.  D WRT^ABMDF11W                      ; form locator #83a
  1.  ;
  1. 59 ;
  1.  W !
  1.  S ABMDE=ABMR(70,190)_"^3^7"     ; Other Procedure code - 3
  1.  D WRT^ABMDF11W                      ; form locator #81e
  1.  S ABMDE=ABMR(70,200)_"^11^6"    ; Other Procedure date - 3
  1.  D WRT^ABMDF11W                      ; form locator #81f
  1.  S ABMDE=ABMR(70,210)_"^18^7"    ; Other Procedure code - 4
  1.  D WRT^ABMDF11W                      ; form locator #81g
  1.  S ABMDE=ABMR(70,220)_"^26^6"    ; Other Procedure date - 4
  1.  D WRT^ABMDF11W                      ; form locator #81h
  1.  S ABMDE=ABMR(70,230)_"^33^7"    ; Other Procedure code - 5
  1.  D WRT^ABMDF11W                      ; form locator #81i
  1.  S ABMDE=ABMR(70,240)_"^41^6"    ; Other Procedure date - 5
  1.  D WRT^ABMDF11W                      ; form locator #81j
  1.  ; Secondary Provider UPIN/MCD #_name
  1.  S ABMDE=$P($G(ABM("PRV",2)),"^",1)_"^49^32"
  1.  D WRT^ABMDF11W                      ; form locator #83b
  1.  ;
  1. 60 ;
  1.  W !
  1.  S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,1,0))_"^^48"  ; remarks line 1
  1.  D WRT^ABMDF11W                      ; form locator #84a
  1.  S ABMDE=$P($G(ABM("PRV",3)),"^",3)_"^59^23"  ; Tertiary Provider Liscence #
  1.  D WRT^ABMDF11W                      ; form locator #83c
  1.  ;
  1. 61 ;
  1.  W !
  1.  S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,2,0))_"^^48"  ; remarks line 2
  1.  D WRT^ABMDF11W                      ; form locator #84b
  1.  ; Tertiary Provider UPIN/MCD #_name
  1.  S ABMDE=$P($G(ABM("PRV",3)),"^",1)_"^49^32"
  1.  D WRT^ABMDF11W                      ; form locator #83d
  1.  ;
  1. 62 ;
  1.  W !
  1.  S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,3,0))_"^^48"  ; remarks line 3
  1.  D WRT^ABMDF11W                      ; form locator #84c
  1.  ;
  1. 63 ;
  1.  W !
  1.  S ABMDE=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,4,0))_"^^48"  ; remarks line 4
  1.  D WRT^ABMDF11W                      ; form locator #84d
  1.  S ABMSIGN=$P($G(^ABMDPARM(DUZ(2),1,3)),"^",8)  ; UB-92 Signature IEN
  1.  S:ABMSIGN="" ABMSIGN=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),"^",4)  ;  Approving official IEN
  1.  S ABMDE=$P($G(^VA(200,+ABMSIGN,20)),"^",2)_"^51^23"  ; Signature block printed name
  1.  D WRT^ABMDF11W                      ; form locator #85
  1.  S ABMDE=$E(DT,4,7)_$E(DT,2,3)_"^74^6"  ; Today's date
  1.  D WRT^ABMDF11W                      ; form locator #86
  1.  Q