| [613] | 1 | PSUCS5 ;BIR/DJE,DJM - PBM CS ASSEMBLE RECORD ;10 JUL 1999
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ; DBIA(s)
|
|---|
| 5 | ; none needed for this routine
|
|---|
| 6 | ;
|
|---|
| 7 | ;
|
|---|
| 8 | ; Build a reporting record(s)
|
|---|
| 9 | ;
|
|---|
| 10 | ;
|
|---|
| 11 | ;
|
|---|
| 12 | BUILDREC ; Assemble record
|
|---|
| 13 | Q:'$G(PSUTQY(5)) ; quit if quantity = 0
|
|---|
| 14 | K PSUR
|
|---|
| 15 | I PSUTYP=2,$S(PSULTP(1)="M":0,PSULTP(1)="S":0,1:1) Q
|
|---|
| 16 | I PSUTYP=17,$S(PSULTP(1)="N":0,1:1) Q
|
|---|
| 17 | I PSUTYP=2 S PSUMCHK=0
|
|---|
| 18 | S PSURIEN=$S(PSUMCHK:PSUMCIEN,1:PSUIENDA)
|
|---|
| 19 | ;S DRUG=$S(PSUTYP=2:PSUDRG(4),1:PSUDSE(4))
|
|---|
| 20 | S DRUG=PSUDRG(4)
|
|---|
| 21 | ;S PSURDIV=$S(PSURI="H":"H",1:1) DAM TEST
|
|---|
| 22 | S PSUR(0)=PSUTYP
|
|---|
| 23 | S PSUR(2)=$G(SENDER)
|
|---|
| 24 | S PSUR(3)=$G(PSURI)
|
|---|
| 25 | ;S PSUR(4)=$P($S(PSUTYP=2:PSUDTM(3),1:""),".",1) ; Just the data
|
|---|
| 26 | S PSUR(4)=PSUDTM(3)\1
|
|---|
| 27 | ;S PSUR(4)=SEE ^XTMP(PSUCSJB,"MC",PSURDIV,PSUIENDA,DRUG)=PSUDTM(3)
|
|---|
| 28 | S PSUR(5)=$G(PSUPLC(.01))
|
|---|
| 29 | S PSUR(6)=$G(PSUSSN(.09))
|
|---|
| 30 | S PSUR(7)=$G(PSUVPN(21))
|
|---|
| 31 | S PSUR(8)=$G(PSUFID(.01))
|
|---|
| 32 | S PSUR(9)=$G(PSUGDN(.01))
|
|---|
| 33 | S PSUR(10)=$G(PSUFID(51))
|
|---|
| 34 | S PSUR(11)=$G(PSUNFI(17))
|
|---|
| 35 | S PSUR(12)=$G(PSUNFR(.01))
|
|---|
| 36 | S PSUR(13)=$G(PSUNDC(31))
|
|---|
| 37 | S PSUR(14)=$G(UNIT)
|
|---|
| 38 | I PSUTYP=2 S PSUR(15)=$G(PSUPDT(8))
|
|---|
| 39 | S PSUR(16)=$G(PSUPDU(16))
|
|---|
| 40 | S PSUR(17)=PSUTQY(5) ; both from type 2 & 17
|
|---|
| 41 | S PSUR(18)=$S($G(PSUDRG(52)):"N/F",1:"")
|
|---|
| 42 | S PSUR(19)=$G(PSUDRG(3))
|
|---|
| 43 | I PSUR(6)'="" S PSUSSN=PSUR(6) D ICN^PSUV2 D
|
|---|
| 44 | .;MVP OIFO BAY PINES;ELR;PSU*3.0*24
|
|---|
| 45 | .S PSUPICN=$G(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
|
|---|
| 46 | S PSUR(20)=$G(PSUPICN)
|
|---|
| 47 | S PSUR=""
|
|---|
| 48 | S I=0 F S I=$O(PSUR(I)) Q:I'>0 S PSUR(I)=$TR(PSUR(I),"^","'")
|
|---|
| 49 | S I=0 F S I=$O(PSUR(I)) Q:I'>0 S $P(PSUR,"^",I)=PSUR(I)
|
|---|
| 50 | S PSUR=PSUR_"^"
|
|---|
| 51 | S PSURC=$G(PSURC,0)+1
|
|---|
| 52 | S PSURDIV=SENDER
|
|---|
| 53 | ;S PSURDIV=$S(PSURI="H":PSUSNDR,1:SENDER) ;PSUTYP=2:$S(PSUOS(20)="":PSUDIV(3.5),1:PSUOS(20)),1:PSUDIV(.015)) DAM TEST
|
|---|
| 54 | I 'PSUMCHK D
|
|---|
| 55 | . S ^XTMP(PSUCSJB,"RECORDS",PSURDIV,PSURIEN)=PSURC
|
|---|
| 56 | . M ^XTMP(PSUCSJB,"RECORDS",PSURDIV,PSURIEN,PSURC)=PSUR
|
|---|
| 57 | I PSUMCHK D
|
|---|
| 58 | . S PSURRC=$G(^XTMP(PSUCSJB,"RECORDS",PSURDIV,PSURIEN))
|
|---|
| 59 | . S $P(^XTMP(PSUCSJB,"RECORDS",PSURDIV,PSURIEN,PSURRC),"^",17)=PSUR(17)
|
|---|
| 60 | K PSUR
|
|---|
| 61 | Q
|
|---|
