PSUUD2 ;BIR/TJH - PBM UNIT DOSE SUBROUTINES & FUNCTIONS ;24 DEC 2003
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
;DBIA(s)
; Reference to file #55 supported by DBIA 2497
;
DISAMT ; precompute dispensed amounts by drug
N DADATE,DADRUG,DAMT,DAHOW
K PSUDAS ; initialize Dispensed Amount Summary array
;*34 |=>
S PSUXX=PSUSDT\1-.0001
DAL134 S PSUXX=$O(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX))
G:'PSUXX DISAMTQ
I PSUXX>PSUTEDT G DISAMTQ
S DISPDA=0
F S DISPDA=$O(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX,DISPDA)) Q:DISPDA'>0 D
. K DISPI
. D GETS^PSUTL(55.0611,"PSPAT,PSDOSE,DISPDA",".01;.02;.03;.05","DISPI","I")
. D MOVEI^PSUTL("DISPI")
. S DADATE=DISPI(.01)
. S DADRUG=$G(DISPI(.02)) G:DADRUG="" DAL134
. S DAMT=$G(DISPI(.03))
. S DAHOW=$G(DISPI(.05))
. S PSUDAS(DADRUG)=$G(PSUDAS(DADRUG))+$S(DAHOW=4:DAMT*-1,1:DAMT) ;net
. I DAHOW'=4 D
..S PSUDAS("DISP",DADRUG)=$G(PSUDAS("DISP",DADRUG))+$G(DAMT) ;Dispense
. I DAHOW=4 D
..S PSUDAS("RET",DADRUG)=$G(PSUDAS("RET",DADRUG))+$G(DAMT) ;Return
. S PSUDAS("NET",DADRUG)=$G(PSUDAS("DISP",DADRUG))-$G(PSUDAS("RET",DADRUG)) ;Net dispensed
.;
. K DISPI
G DAL134
;*34 <=|
DISAMTQ K ^TMP($J,"PSUTA") Q ; exit point from DISAMT subroutine
;
SETUP ; set up some variables required later
D SECTN^PSUTL1
D DT^DILF("E",PSUSDT,.EXTD)
S PSURP("START")=EXTD(0)
D DT^DILF("E",PSUEDT,.EXTD)
S PSURP("END")=EXTD(0)
S X1=PSUSDT,X2=-101
D C^%DTC K %,%H,%T
S PSDATE=X
S PSUEDTIM=PSUEDT+.2400
S PSUJOB=$G(PSUJOB,$J),PSUUDSUB="PSUUD_"_PSUJOB
K ^XTMP(PSUUDSUB)
K PSUDTLRN
S X1=DT,X2=3 D C^%DTC
S ^XTMP(PSUUDSUB,0)=X_U_DT_U_"PSU PBM UNIT DOSE STATISTICAL DATA"
SETUPQ Q ; exit from SETUP
;
TMPUD ; store Unit Dose data in first half of record, pieces 2-7
S DLM="^",REC1="^"
S REC1=REC1_$TR(PSUFACN,"^","'")_DLM_$TR(PSUDOSE(10),"^","'")_DLM_$TR(PSUDOSE(.01),"^","'")
S REC1=REC1_DLM_PSUSSN_DLM_$TR(PSUDOSE(26),"^","'")_DLM_PSUVSSN ;_DLM_$TR(PSUVCL,"^","'")
;S REC1=REC1_DLM_$TR(PSUVSV,"^","'")_DLM_$TR(PSUVS1,"^","'")_DLM_$TR(PSUVS2,"^","'")
TMPUDQ Q ; exit from TMPUD
;
TMPDD ; create Dispense Drug record and store in ^XTMP
N PSUDAMT S PSUDAMT=$G(PSUDAS(PSUDISD(.01)))
Q:'PSUDAMT ; per Lina B., do not store if dispensed amount=0
S DLM="^",REC2="",PSUDTLRN(PSUFACN)=+$G(PSUDTLRN(PSUFACN))+1
S REC2=REC1_DLM_$TR(PSUDRUG(21),"^","'")_DLM_$TR(PSUDRUG(2),"^","'")_DLM
S REC2=REC2_$TR(PSUDRUG(.01),"^","'")_DLM_$TR(PSUDRUG(31),"^","'")_DLM
S REC2=REC2_PSUDRUG(51)_DLM_PSUDNFI_DLM_PSUDNFR_DLM
S REC2=REC2_$TR(PSUDISD(.02),"^","'")_DLM_$TR(PSUDRUG(14.5),"^","'")_DLM
S REC2=REC2_$TR(PSUDRUG(16),"^","'")_DLM_PSUDAMT_DLM_PSUDRUG(52)_DLM_PSUDRUG(3)_"^"
;VMP OIFO BAY PINES;ELR;PSU*3.0*24
D ICN^PSUV1 S PSUPICN=$G(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
S REC2=REC2_$G(PSUPICN)_DLM_$G(PSUDOSE(1))_DLM_PSUUDST_DLM
;
;ADD AMIS DATA
N PSUDSP,PSURET
S PSUDSP=$G(PSUDAS("DISP",PSUDISD(.01)))
S ^XTMP(PSUUDSUB,"DISP",PSUFACN)=PSUDSP+$G(^XTMP(PSUUDSUB,"DISP",PSUFACN))
S PSURET=$G(PSUDAS("RET",PSUDISD(.01)))
S ^XTMP(PSUUDSUB,"RET",PSUFACN)=PSURET+$G(^XTMP(PSUUDSUB,"RET",PSUFACN))
S:'$G(PSURET) PSURET=0
S REC2=REC2_PSUDSP_DLM_PSURET_DLM
;END AMIS DATA
;
S ^XTMP(PSUUDSUB,"DETAIL",PSUFACN,PSUDTLRN(PSUFACN))=REC2
; increase Unit Dose and Patient counts if not already counted
I '$D(^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01))) D
.S ^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01))=""
.S ^XTMP(PSUUDSUB,"ORD",PSUFACN)=1+$G(^XTMP(PSUUDSUB,"ORD",PSUFACN))
I '$D(^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN)) D
.S ^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN)=""
.S ^XTMP(PSUUDSUB,"SSN",PSUFACN)=1+$G(^XTMP(PSUUDSUB,"SSN",PSUFACN))
S PSUDIV=PSUFACN D GETDIV^PSUV3 I PSUDIVNM'="" D
.S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)=""
I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
; and store totals by drug in ^TMP("PSUUD DRUG",$J,PSUFACN
I '$D(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01))) D
.S ^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01))=0_U_PSUDRUG(16)_U_PSUDRUG(51)_U_PSUDNFI
S $P(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)=$P(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)+PSUDAMT
; and store Summary totals
S ^XTMP(PSUUDSUB,"DIS",PSUFACN)=PSUDAMT+$G(^XTMP(PSUUDSUB,"DIS",PSUFACN))
S ^XTMP(PSUUDSUB,"CST",PSUFACN)=(PSUDRUG(16)*PSUDAMT)+$G(^XTMP(PSUUDSUB,"CST",PSUFACN))
TMPDDQ Q ; exit from TMPDD
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSUUD2 4390 printed Oct 16, 2024@18:29:21 Page 2
PSUUD2 ;BIR/TJH - PBM UNIT DOSE SUBROUTINES & FUNCTIONS ;24 DEC 2003
+1 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
+2 ;DBIA(s)
+3 ; Reference to file #55 supported by DBIA 2497
+4 ;
DISAMT ; precompute dispensed amounts by drug
+1 NEW DADATE,DADRUG,DAMT,DAHOW
+2 ; initialize Dispensed Amount Summary array
KILL PSUDAS
+3 ;*34 |=>
+4 SET PSUXX=PSUSDT\1-.0001
DAL134 SET PSUXX=$ORDER(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX))
+1 if 'PSUXX
GOTO DISAMTQ
+2 IF PSUXX>PSUTEDT
GOTO DISAMTQ
+3 SET DISPDA=0
+4 FOR
SET DISPDA=$ORDER(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX,DISPDA))
if DISPDA'>0
QUIT
Begin DoDot:1
+5 KILL DISPI
+6 DO GETS^PSUTL(55.0611,"PSPAT,PSDOSE,DISPDA",".01;.02;.03;.05","DISPI","I")
+7 DO MOVEI^PSUTL("DISPI")
+8 SET DADATE=DISPI(.01)
+9 SET DADRUG=$GET(DISPI(.02))
if DADRUG=""
GOTO DAL134
+10 SET DAMT=$GET(DISPI(.03))
+11 SET DAHOW=$GET(DISPI(.05))
+12 ;net
SET PSUDAS(DADRUG)=$GET(PSUDAS(DADRUG))+$SELECT(DAHOW=4:DAMT*-1,1:DAMT)
+13 IF DAHOW'=4
Begin DoDot:2
+14 ;Dispense
SET PSUDAS("DISP",DADRUG)=$GET(PSUDAS("DISP",DADRUG))+$GET(DAMT)
End DoDot:2
+15 IF DAHOW=4
Begin DoDot:2
+16 ;Return
SET PSUDAS("RET",DADRUG)=$GET(PSUDAS("RET",DADRUG))+$GET(DAMT)
End DoDot:2
+17 ;Net dispensed
SET PSUDAS("NET",DADRUG)=$GET(PSUDAS("DISP",DADRUG))-$GET(PSUDAS("RET",DADRUG))
+18 ;
+19 KILL DISPI
End DoDot:1
+20 GOTO DAL134
+21 ;*34 <=|
DISAMTQ ; exit point from DISAMT subroutine
KILL ^TMP($JOB,"PSUTA")
QUIT
+1 ;
SETUP ; set up some variables required later
+1 DO SECTN^PSUTL1
+2 DO DT^DILF("E",PSUSDT,.EXTD)
+3 SET PSURP("START")=EXTD(0)
+4 DO DT^DILF("E",PSUEDT,.EXTD)
+5 SET PSURP("END")=EXTD(0)
+6 SET X1=PSUSDT
SET X2=-101
+7 DO C^%DTC
KILL %,%H,%T
+8 SET PSDATE=X
+9 SET PSUEDTIM=PSUEDT+.2400
+10 SET PSUJOB=$GET(PSUJOB,$JOB)
SET PSUUDSUB="PSUUD_"_PSUJOB
+11 KILL ^XTMP(PSUUDSUB)
+12 KILL PSUDTLRN
+13 SET X1=DT
SET X2=3
DO C^%DTC
+14 SET ^XTMP(PSUUDSUB,0)=X_U_DT_U_"PSU PBM UNIT DOSE STATISTICAL DATA"
SETUPQ ; exit from SETUP
QUIT
+1 ;
TMPUD ; store Unit Dose data in first half of record, pieces 2-7
+1 SET DLM="^"
SET REC1="^"
+2 SET REC1=REC1_$TRANSLATE(PSUFACN,"^","'")_DLM_$TRANSLATE(PSUDOSE(10),"^","'")_DLM_$TRANSLATE(PSUDOSE(.01),"^","'")
+3 ;_DLM_$TR(PSUVCL,"^","'")
SET REC1=REC1_DLM_PSUSSN_DLM_$TRANSLATE(PSUDOSE(26),"^","'")_DLM_PSUVSSN
+4 ;S REC1=REC1_DLM_$TR(PSUVSV,"^","'")_DLM_$TR(PSUVS1,"^","'")_DLM_$TR(PSUVS2,"^","'")
TMPUDQ ; exit from TMPUD
QUIT
+1 ;
TMPDD ; create Dispense Drug record and store in ^XTMP
+1 NEW PSUDAMT
SET PSUDAMT=$GET(PSUDAS(PSUDISD(.01)))
+2 ; per Lina B., do not store if dispensed amount=0
if 'PSUDAMT
QUIT
+3 SET DLM="^"
SET REC2=""
SET PSUDTLRN(PSUFACN)=+$GET(PSUDTLRN(PSUFACN))+1
+4 SET REC2=REC1_DLM_$TRANSLATE(PSUDRUG(21),"^","'")_DLM_$TRANSLATE(PSUDRUG(2),"^","'")_DLM
+5 SET REC2=REC2_$TRANSLATE(PSUDRUG(.01),"^","'")_DLM_$TRANSLATE(PSUDRUG(31),"^","'")_DLM
+6 SET REC2=REC2_PSUDRUG(51)_DLM_PSUDNFI_DLM_PSUDNFR_DLM
+7 SET REC2=REC2_$TRANSLATE(PSUDISD(.02),"^","'")_DLM_$TRANSLATE(PSUDRUG(14.5),"^","'")_DLM
+8 SET REC2=REC2_$TRANSLATE(PSUDRUG(16),"^","'")_DLM_PSUDAMT_DLM_PSUDRUG(52)_DLM_PSUDRUG(3)_"^"
+9 ;VMP OIFO BAY PINES;ELR;PSU*3.0*24
+10 DO ICN^PSUV1
SET PSUPICN=$GET(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
+11 SET REC2=REC2_$GET(PSUPICN)_DLM_$GET(PSUDOSE(1))_DLM_PSUUDST_DLM
+12 ;
+13 ;ADD AMIS DATA
+14 NEW PSUDSP,PSURET
+15 SET PSUDSP=$GET(PSUDAS("DISP",PSUDISD(.01)))
+16 SET ^XTMP(PSUUDSUB,"DISP",PSUFACN)=PSUDSP+$GET(^XTMP(PSUUDSUB,"DISP",PSUFACN))
+17 SET PSURET=$GET(PSUDAS("RET",PSUDISD(.01)))
+18 SET ^XTMP(PSUUDSUB,"RET",PSUFACN)=PSURET+$GET(^XTMP(PSUUDSUB,"RET",PSUFACN))
+19 if '$GET(PSURET)
SET PSURET=0
+20 SET REC2=REC2_PSUDSP_DLM_PSURET_DLM
+21 ;END AMIS DATA
+22 ;
+23 SET ^XTMP(PSUUDSUB,"DETAIL",PSUFACN,PSUDTLRN(PSUFACN))=REC2
+24 ; increase Unit Dose and Patient counts if not already counted
+25 IF '$DATA(^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01)))
Begin DoDot:1
+26 SET ^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01))=""
+27 SET ^XTMP(PSUUDSUB,"ORD",PSUFACN)=1+$GET(^XTMP(PSUUDSUB,"ORD",PSUFACN))
End DoDot:1
+28 IF '$DATA(^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN))
Begin DoDot:1
+29 SET ^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN)=""
+30 SET ^XTMP(PSUUDSUB,"SSN",PSUFACN)=1+$GET(^XTMP(PSUUDSUB,"SSN",PSUFACN))
End DoDot:1
+31 SET PSUDIV=PSUFACN
DO GETDIV^PSUV3
IF PSUDIVNM'=""
Begin DoDot:1
+32 SET ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)=""
End DoDot:1
+33 IF PSUDIVNM=""
SET ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
+34 ; and store totals by drug in ^TMP("PSUUD DRUG",$J,PSUFACN
+35 IF '$DATA(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)))
Begin DoDot:1
+36 SET ^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01))=0_U_PSUDRUG(16)_U_PSUDRUG(51)_U_PSUDNFI
End DoDot:1
+37 SET $PIECE(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)=$PIECE(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)+PSUDAMT
+38 ; and store Summary totals
+39 SET ^XTMP(PSUUDSUB,"DIS",PSUFACN)=PSUDAMT+$GET(^XTMP(PSUUDSUB,"DIS",PSUFACN))
+40 SET ^XTMP(PSUUDSUB,"CST",PSUFACN)=(PSUDRUG(16)*PSUDAMT)+$GET(^XTMP(PSUUDSUB,"CST",PSUFACN))
TMPDDQ ; exit from TMPDD
QUIT
