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