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

BUDCRPC3.m

Go to the documentation of this file. 
  1. BUDCRPC3 ; IHS/CMI/LAB - UDS TABLE 6 ; 11 Dec 2015  10:13 AM
  1.  ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
  1. T9D ;EP
  1.  NEW BUDAIEN,BUDDATE,BUD0,BUDREC,BUDCILL,Z,BUDPIEC
  1.  S BUDAIEN=0
  1.  F  S BUDAIEN=$O(^BARTR(DUZ(2),"AF",DFN,BUDAIEN)) Q:BUDAIEN'=+BUDAIEN  D
  1.  .Q:'$D(^BARTR(DUZ(2),BUDAIEN))
  1.  .Q:'$D(^BARTR(DUZ(2),BUDAIEN,0))
  1.  .S BUD0=^BARTR(DUZ(2),BUDAIEN,0)
  1.  .S BUDDATE=$P(BUD0,U,12)
  1.  .Q:$P(BUDDATE,".")<BUDBD  ;ONLY UDS DATE RANGE
  1.  .Q:$P(BUDDATE,".")>BUDED
  1.  .S BUDREC="",BUDPIEC=0
  1.  .;DATE
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT(BUDDATE)
  1.  .;BILL NUMBER
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,4)
  1.  .;TRANSACTION TYPE
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,101)
  1.  .;CREDIT 2 A/R TRANSACTION FILE
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$P(BUD0,U,2)
  1.  .;DEBIT 3 A/R TRANSACTION FILE
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$P(BUD0,U,3)
  1.  .;PRIME BILL AMOUNT
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.2)
  1.  .;PAYMENT
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.6)
  1.  .;ADJUSTMENT
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.7)
  1.  .;ADJUSTMENT CATEGORY
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,102)
  1.  .;ADJUSTMENT TYPE
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,103)
  1.  .;A/R ACCOUNT
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,6)
  1.  .;PATIENT
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,5)
  1.  .;VISIT LOCATION
  1.  .S BUDCILL=$$VALI^XBDIQ1(90050.03,BUDAIEN,4)
  1.  .I BUDCILL S Z=$$VAL^XBDIQ1(90050.01,BUDCILL,108)
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=Z
  1.  .;CLINIC TYPE
  1.  .I BUDCILL S Z=$$VAL^XBDIQ1(90050.01,BUDCILL,112)
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=Z
  1.  .;DOS BEGIN
  1.  .I BUDCILL S Z=$$VAL^XBDIQ1(90050.01,BUDCILL,102)
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=Z
  1.  .;BILL TYPE
  1.  .I BUDCILL S Z=$$VAL^XBDIQ1(90050.01,BUDCILL,4)
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=Z
  1.  .;PRIMARY PROVIDER
  1.  .I BUDCILL S Z=$$VAL^XBDIQ1(90050.01,BUDCILL,113)
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=Z
  1.  .;HRN
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$HRN^AUPNPAT(DFN,DUZ(2))
  1.  .;DOB
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT($$DOB^AUPNPAT(DFN))
  1.  .;COMMUNITY
  1.  .S BUDPIEC=BUDPIEC+1
  1.  .S $P(BUDREC,U,BUDPIEC)=$$COMMRES^AUPNPAT(DFN,"E")
  1.  .D SET
  1.  .Q
  1.  Q
  1. SET ;
  1.  S BUDT9C=BUDT9C+1
  1.  S ^XTMP("BUDARP9DEL",BUDJ,BUDH,BUDDATE,BUDT9C)=BUDREC
  1.  Q
  1. OPIC ;EP
  1.  ; I = IEN
  1.  ; Y = 1:yes, 0:no
  1.  ; X = Pointer to INSURER file.
  1.  I '$G(P) Q 0
  1.  I '$G(D) Q 0
  1.  NEW I,Y,X,G
  1.  S Y=0,U="^"
  1.  I '$D(^DPT(P,0)) G OPICX
  1.  I $P(^DPT(P,0),U,19) G OPICX
  1.  I '$D(^AUPNPAT(P,0)) G OPICX
  1.  I '$D(^AUPNPRVT(P,11)) G OPICX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G OPICX
  1.  S I=0,G=0
  1.  F  S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I  D
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
  1.  . S G=0
  1.  . S X=$P(^AUPNPRVT(P,11,I,0),U) Q:X=""
  1.  . I $P($G(^AUTNINS(X,2)),U,1)=T S G=1
  1.  . Q:'G
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
  1.  . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
  1.  . S Y=1
  1.  .Q
  1.  I Y Q Y
  1. OPICX ;EP
  1.  Q Y
  1. OPI ;EP
  1.  ; I = IEN
  1.  ; Y = 1:yes, 0:no
  1.  ; X = Pointer to INSURER file.
  1.  I '$G(P) Q 0
  1.  I '$G(D) Q 0
  1.  NEW I,Y,X,G
  1.  S Y=0,U="^"
  1.  I '$D(^DPT(P,0)) G OPIX
  1.  I $P(^DPT(P,0),U,19) G OPIX
  1.  I '$D(^AUPNPAT(P,0)) G OPIX
  1.  I '$D(^AUPNPRVT(P,11)) G OPIX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G OPIX
  1.  S I=0,G=0
  1.  F  S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I  D
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
  1.  . S G=0
  1.  . S X=$P(^AUPNPRVT(P,11,I,0),U) Q:X=""
  1.  . ;I $P($G(^AUTNINS(X,2)),U,1)="G" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="I" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="SEP" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="T" S G=1
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
  1.  . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
  1.  . S Y=1
  1.  .Q
  1.  I Y Q Y
  1. OPIX ;
  1.  Q Y
  1. PI ;EP
  1.  ; I = IEN
  1.  ; Y = 1:yes, 0:no
  1.  ; X = Pointer to INSURER file.
  1.  I '$G(P) Q 0
  1.  I '$G(D) Q 0
  1.  NEW I,Y,X,G
  1.  S Y=0,U="^"
  1.  I '$D(^DPT(P,0)) G PIX
  1.  I $P(^DPT(P,0),U,19) G PIX
  1.  I '$D(^AUPNPAT(P,0)) G PIX
  1.  I '$D(^AUPNPRVT(P,11)) G PIX
  1.  I $D(^DPT(P,.35)),$P(^(.35),U)]"",$P(^(.35),U)<D G PIX
  1.  S I=0
  1.  F  S I=$O(^AUPNPRVT(P,11,I)) Q:I'=+I  D
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U)=""
  1.  . S X=$P(^AUPNPRVT(P,11,I,0),U) Q:X=""
  1.  . Q:$P(^AUTNINS(X,0),U)["AHCCCS"
  1.  . S G=0
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="C" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="F" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="H" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="M" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="P" S G=1
  1.  . I $P($G(^AUTNINS(X,2)),U,1)="W" S G=1
  1.  . Q:'G
  1.  . Q:$P(^AUPNPRVT(P,11,I,0),U,6)>D
  1.  . I $P(^AUPNPRVT(P,11,I,0),U,7)]"",$P(^(0),U,7)<D Q
  1.  . S Y=1
  1.  .Q
  1. PIX ;
  1.  Q Y
  1. ZIPINS(DFN,BUDLASTV) ;EP - ZIP INSURANCE
  1.  NEW BUDHAS
  1.  S BUDHAS=0
  1.  S BUDHAS=$$PI^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV))
  1.  I BUDHAS=1 Q "e"
  1.  S BUDHAS=$$MCR^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV))
  1.  I BUDHAS=1 Q "d"
  1.  ;S BUDHAS=$$OPI(DFN,$$VD^APCLV(BUDLASTV),"W")
  1.  ;I BUDHAS=1 D TINS(BUDAGE,"10a") Q
  1.  S BUDHAS=$$RR^AUPNPAT(DFN,$$VD^APCLV(BUDLASTV))
  1.  I BUDHAS=1 Q "c"
  1.  S BUDHAS=$$OPI^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV))
  1.  I BUDHAS=1 Q "c"
  1.  S BUDHAS=$$OPIC^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV),"K")
  1.  I BUDHAS=1 Q "c"
  1.  S BUDHAS=$$MCD^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV),"D")
  1.  I BUDHAS=1 Q "c"
  1.  S BUDHAS=$$MCD^BUDCRPC2(DFN,$$VD^APCLV(BUDLASTV),"K")
  1.  I BUDHAS=1 Q "c"
  1.  ;now check workman's comp and 3rd party liability
  1.  S BUDHAS=$$WC^BUDCRPC2(DFN,BUDBD,BUDED)
  1.  I BUDHAS=1 Q "c"
  1.  S BUDHAS=$$TPL^BUDCRPC2(DFN,BUDBD,BUDED)
  1.  I BUDHAS=1 Q "c"
  1.  ;now check guarantor file
  1.  ;S BUDHAS=$$GUAR(DFN,BUDBD,BUDED)
  1.  ;I BUDHAS=1 D TINS(BUDAGE,"7") Q
  1.  Q "b"