source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCS5.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1PSUCS5 ;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 ;
12BUILDREC ; 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
Note: See TracBrowser for help on using the repository browser.