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

ABMDF51Z.m

Go to the documentation of this file. 
  1. ABMDF51Z ;IHS/DSD/DMJ/LSL - PRINT UB92     
  1.  ;;2.6;IHS 3P BILLING SYSTEM;**14,21**;NOV 12, 2009;Build 379
  1.  ;Original;DMJ;
  1.  ;
  1.  ;IHS/SD/SDR - v2.5 p9 - IM15936 - Added check for Medi-Cal
  1.  ;IHS/SD/SDR - v2.5 p9 - IM17233 - Removed "." from Dxs
  1.  ;IHS/SD/SDR - v2.5 p10 - IM20981 - Correction to error <UNDEF>58+14^ABMDF51Z
  1.  ;IHS/SD/SDR - v2.5 p11 - IM24315 - Made FL 64/65/66 not print for Medi-Cal
  1.  ;
  1.  ;IHS/SD/SDR - 2.6*21 - HEAT123457 - Updated 61044 checks from 'equals' to 'contains'
  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 ABMPBAL=+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),2)),"^",3)-ABMPAID
  1.  . S: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.  .;Q:$E(ABMREC(30,I),26,30)'=61044  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .Q:$E(ABMREC(30,I),26,30)'["61044"  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .Q:I'=$G(ABMFLAG)
  1.  .W !
  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.  .S ABMDE=$E(ABMREC(30,I),144,145)_"^26^2"  ; Pat relation to Ins
  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.  .S ABMDE=$E(ABMREC(30,I),80,96)_"^64^17"   ; Insurance Group Num
  1.  W:'$G(ABMFLAG) !
  1.  W !!
  1.  K ABMQUIT,ABMFLAG
  1.  ;
  1. 51 ;
  1.  W !
  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.  .;I $$RCID^ABMERUTL(ABMP("INS"))=61044 Q  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .I $$RCID^ABMERUTL(ABMP("INS"))["61044" Q  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  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=$TR(ABMR(70,40),".")_"^^6"       ; Principle Diagnosis
  1.  D WRT^ABMDF11W                      ; form locator #67
  1.  S ABMDE=$TR(ABMR(70,50),".")_"^7^6"      ; Other Diagnosis Code 1
  1.  D WRT^ABMDF11W                      ; form locator #68
  1.  S ABMDE=$TR(ABMR(70,60),".")_"^14^6"     ; Other Diagnosis Code 2
  1.  D WRT^ABMDF11W                      ; form locator #69
  1.  S ABMDE=$TR(ABMR(70,70),".")_"^21^6"     ; Other Diagnosis Code 3
  1.  D WRT^ABMDF11W                      ; form locator #70
  1.  S ABMDE=$TR(ABMR(70,80),".")_"^28^6"     ; Other Diagnosis Code 4
  1.  D WRT^ABMDF11W                      ; form locator #71
  1.  S ABMDE=$TR(ABMR(70,90),".")_"^35^6"     ; Other Diagnosis Code 5
  1.  D WRT^ABMDF11W                      ; form locator #72
  1.  S ABMDE=$TR(ABMR(70,100),".")_"^42^6"    ; Other Diagnosis Code 6
  1.  D WRT^ABMDF11W                      ; form locator #73
  1.  S ABMDE=$TR(ABMR(70,110),".")_"^49^6"    ; Other Diagnosis Code 7
  1.  D WRT^ABMDF11W                      ; form locator #74
  1.  S ABMDE=$TR(ABMR(70,120),".")_"^56^6"    ; Other Diagnosis Code 8
  1.  D WRT^ABMDF11W                      ; form locator #75
  1.  S ABMDE=$TR(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
  1.  ; Primary Provider State License #
  1.  S ABMDE=$P($G(ABM("PRV",1)),"^",3)_"^59^23"
  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.  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)),U)_"^49^32"
  1.  ;
  1. 58 ;
  1.  ; Secondary Provider License #
  1.  W !
  1.  S ABMDE=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),0)),"^",8)_"^59^23"
  1.  ;I $$RCID^ABMERUTL(ABMP("INS"))=61044 D     ;as long as we are talking MEDI-CAL  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  I $$RCID^ABMERUTL(ABMP("INS"))["61044" D     ;as long as we are talking MEDI-CAL  ;abm*2.6*21 IHS/SD/SDR HEAT123457
  1.  .N ABMDFX,ABMDFP,ABMDFO
  1.  .;Get Attending provider dfn from Bill file-
  1.  .S ABMDFX=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",""))
  1.  .S ABMDFP=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMDFX,0),"^")
  1.  .;Get O/P MEDI-CAL  9 dfn from Insurer file
  1.  .S ABMDFO=$O(^AUTNINS("B","O/P MEDI-CAL  9",""))
  1.  .;Get PIN out of the 3P Insurer file Provider multiple, 3rd subscript
  1.  .Q:ABMDFO=""  ;didn't find entry
  1.  .S ABMDE=$P($G(^ABMNINS(DUZ(2),ABMDFO,3,ABMDFP,0)),"^",2)_"^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)),U)_"^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)),U)_"^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
  1.  ;
  1. PROV ;
  1.  ; PROVIDER INFORMATION
  1.  ; ABM("PRV",#) = UPIN/MCD #_Provider name ^ UPIN/MCD# ^
  1.  ;                Provider State License Number
  1.  S ABMPRVTP=0   ; Initialize Provider Type
  1.  S ABMPCNT=0   ; Initialize Provider Count
  1.  F  S ABMPRVTP=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP)) Q:ABMPRVTP=""  D
  1.  . S ABMPRVNO=0  ; Initialize Provider Number
  1.  . F  S ABMPRVNO=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C",ABMPRVTP,ABMPRVNO)) Q:'ABMPRVNO  D
  1.  . . ; NEW PERSON file IEN
  1.  . . S ABMPRV=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRVNO,0),U)
  1.  . . S ABMPCNT=ABMPCNT+1   ; Increment provider count
  1.  . . Q:ABMPCNT>3   ; only 1st 3 providers
  1.  . . S ABM("PRV",ABMPCNT)=$P($G(^VA(200,ABMPRV,0)),U)  ; Provider name
  1.  . . S ABM("PRV",ABMPCNT)=$TR(ABM("PRV",ABMPCNT),","," ")
  1.  . . ; If Medicare FI, find provider UPIN
  1.  . . I ABMP("ITYPE")="R" D
  1.  . . . S ABMUPIN=$P($G(^VA(200,ABMPRV,9999999)),"^",8)
  1.  . . . S:ABMUPIN="" ABMUPIN="PHS000"
  1.  . . . Q
  1.  . . S $P(ABM("PRV",ABMPCNT),"^",2)=$S(ABMP("ITYPE")="D":$P(^VA(200,ABMPRV,9999999),"^",7),ABMP("ITYPE")="R":ABMUPIN,1:"")
  1.  . . S:$P(ABM("PRV",ABMPCNT),"^",2)]"" $P(ABM("PRV",ABMPCNT),"^")=$P(ABM("PRV",ABMPCNT),"^",2)_"  "_$P(ABM("PRV",ABMPCNT),"^")
  1.  . . S ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",23)  ; state IEN
  1.  . . S:ABMVST="" ABMVST=$P($G(^AUTTLOC(+ABMP("LDFN"),0)),"^",14)
  1.  . . S $P(ABM("PRV",ABMPCNT),"^",3)=$$SLN^ABMERUTL(ABMPRV,ABMVST)  ; Provider State License number
  1.  Q