BUD1RPC3 ; IHS/CMI/LAB - UDS TABLE 6 11 Dec 2007 12:15 PM ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
T9D ;EP
NEW BUDAIEN,BUDDATE,BUD0,BUDREC,BUDBILL,Z,BUDPIEC
S BUDAIEN=0
F S BUDAIEN=$O(^BARTR(DUZ(2),"AF",DFN,BUDAIEN)) Q:BUDAIEN'=+BUDAIEN D
.Q:'$D(^BARTR(DUZ(2),BUDAIEN))
.S BUD0=^BARTR(DUZ(2),BUDAIEN,0)
.S BUDDATE=$P(BUD0,U,12)
.Q:$P(BUDDATE,".")<BUDBD ;ONLY UDS DATE RANGE
.Q:$P(BUDDATE,".")>BUDED
.S BUDREC="",BUDPIEC=0
.;DATE
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT(BUDDATE)
.;BILL NUMBER
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,4)
.;TRANSACTION TYPE
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,101)
.;CREDIT 2 A/R TRANSACTION FILE
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$P(BUD0,U,2)
.;DEBIT 3 A/R TRANSACTION FILE
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$P(BUD0,U,3)
.;PRIME BILL AMOUNT
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.2)
.;PAYMENT
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.6)
.;ADJUSTMENT
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.7)
.;ADJUSTMENT CATEGORY
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,102)
.;ADJUSTMENT TYPE
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,103)
.;A/R ACCOUNT
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,6)
.;PATIENT
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,5)
.;VISIT LOCATION
.S BUDBILL=$$VALI^XBDIQ1(90050.03,BUDAIEN,4)
.I BUDBILL S Z=$$VAL^XBDIQ1(90050.01,BUDBILL,108)
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=Z
.;CLINIC TYPE
.I BUDBILL S Z=$$VAL^XBDIQ1(90050.01,BUDBILL,112)
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=Z
.;DOS BEGIN
.I BUDBILL S Z=$$VAL^XBDIQ1(90050.01,BUDBILL,102)
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=Z
.;BILL TYPE
.I BUDBILL S Z=$$VAL^XBDIQ1(90050.01,BUDBILL,4)
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=Z
.;PRIMARY PROVIDER
.I BUDBILL S Z=$$VAL^XBDIQ1(90050.01,BUDBILL,113)
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=Z
.;HRN
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$HRN^AUPNPAT(DFN,DUZ(2))
.;DOB
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT($$DOB^AUPNPAT(DFN))
.;COMMUNITY
.S BUDPIEC=BUDPIEC+1
.S $P(BUDREC,U,BUDPIEC)=$$COMMRES^AUPNPAT(DFN,"E")
.D SET
.Q
Q
SET ;
S BUDT9C=BUDT9C+1
S ^XTMP("BUD1RP9DEL",BUDJ,BUDH,BUDDATE,BUDT9C)=BUDREC
Q
BUD1RPC3 ; IHS/CMI/LAB - UDS TABLE 6 11 Dec 2007 12:15 PM ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
T9D ;EP
+1 NEW BUDAIEN,BUDDATE,BUD0,BUDREC,BUDBILL,Z,BUDPIEC
+2 SET BUDAIEN=0
+3 FOR
SET BUDAIEN=$ORDER(^BARTR(DUZ(2),"AF",DFN,BUDAIEN))
IF BUDAIEN'=+BUDAIEN
QUIT
Begin DoDot:1
+4 IF '$DATA(^BARTR(DUZ(2),BUDAIEN))
QUIT
+5 SET BUD0=^BARTR(DUZ(2),BUDAIEN,0)
+6 SET BUDDATE=$PIECE(BUD0,U,12)
+7 ;ONLY UDS DATE RANGE
IF $PIECE(BUDDATE,".")<BUDBD
QUIT
+8 IF $PIECE(BUDDATE,".")>BUDED
QUIT
+9 SET BUDREC=""
SET BUDPIEC=0
+10 ;DATE
+11 SET BUDPIEC=BUDPIEC+1
+12 SET $PIECE(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT(BUDDATE)
+13 ;BILL NUMBER
+14 SET BUDPIEC=BUDPIEC+1
+15 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,4)
+16 ;TRANSACTION TYPE
+17 SET BUDPIEC=BUDPIEC+1
+18 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,101)
+19 ;CREDIT 2 A/R TRANSACTION FILE
+20 SET BUDPIEC=BUDPIEC+1
+21 SET $PIECE(BUDREC,U,BUDPIEC)=$PIECE(BUD0,U,2)
+22 ;DEBIT 3 A/R TRANSACTION FILE
+23 SET BUDPIEC=BUDPIEC+1
+24 SET $PIECE(BUDREC,U,BUDPIEC)=$PIECE(BUD0,U,3)
+25 ;PRIME BILL AMOUNT
+26 SET BUDPIEC=BUDPIEC+1
+27 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.2)
+28 ;PAYMENT
+29 SET BUDPIEC=BUDPIEC+1
+30 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.6)
+31 ;ADJUSTMENT
+32 SET BUDPIEC=BUDPIEC+1
+33 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,3.7)
+34 ;ADJUSTMENT CATEGORY
+35 SET BUDPIEC=BUDPIEC+1
+36 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,102)
+37 ;ADJUSTMENT TYPE
+38 SET BUDPIEC=BUDPIEC+1
+39 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,103)
+40 ;A/R ACCOUNT
+41 SET BUDPIEC=BUDPIEC+1
+42 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,6)
+43 ;PATIENT
+44 SET BUDPIEC=BUDPIEC+1
+45 SET $PIECE(BUDREC,U,BUDPIEC)=$$VAL^XBDIQ1(90050.03,BUDAIEN,5)
+46 ;VISIT LOCATION
+47 SET BUDBILL=$$VALI^XBDIQ1(90050.03,BUDAIEN,4)
+48 IF BUDBILL
SET Z=$$VAL^XBDIQ1(90050.01,BUDBILL,108)
+49 SET BUDPIEC=BUDPIEC+1
+50 SET $PIECE(BUDREC,U,BUDPIEC)=Z
+51 ;CLINIC TYPE
+52 IF BUDBILL
SET Z=$$VAL^XBDIQ1(90050.01,BUDBILL,112)
+53 SET BUDPIEC=BUDPIEC+1
+54 SET $PIECE(BUDREC,U,BUDPIEC)=Z
+55 ;DOS BEGIN
+56 IF BUDBILL
SET Z=$$VAL^XBDIQ1(90050.01,BUDBILL,102)
+57 SET BUDPIEC=BUDPIEC+1
+58 SET $PIECE(BUDREC,U,BUDPIEC)=Z
+59 ;BILL TYPE
+60 IF BUDBILL
SET Z=$$VAL^XBDIQ1(90050.01,BUDBILL,4)
+61 SET BUDPIEC=BUDPIEC+1
+62 SET $PIECE(BUDREC,U,BUDPIEC)=Z
+63 ;PRIMARY PROVIDER
+64 IF BUDBILL
SET Z=$$VAL^XBDIQ1(90050.01,BUDBILL,113)
+65 SET BUDPIEC=BUDPIEC+1
+66 SET $PIECE(BUDREC,U,BUDPIEC)=Z
+67 ;HRN
+68 SET BUDPIEC=BUDPIEC+1
+69 SET $PIECE(BUDREC,U,BUDPIEC)=$$HRN^AUPNPAT(DFN,DUZ(2))
+70 ;DOB
+71 SET BUDPIEC=BUDPIEC+1
+72 SET $PIECE(BUDREC,U,BUDPIEC)=$$FMTE^XLFDT($$DOB^AUPNPAT(DFN))
+73 ;COMMUNITY
+74 SET BUDPIEC=BUDPIEC+1
+75 SET $PIECE(BUDREC,U,BUDPIEC)=$$COMMRES^AUPNPAT(DFN,"E")
+76 DO SET
+77 QUIT
End DoDot:1
+78 QUIT
SET ;
+1 SET BUDT9C=BUDT9C+1
+2 SET ^XTMP("BUD1RP9DEL",BUDJ,BUDH,BUDDATE,BUDT9C)=BUDREC
+3 QUIT
