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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUCS5 2013 printed Nov 22, 2024@17:37:39 Page 2
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
