101 lines
4.2 KiB
Mathematica
101 lines
4.2 KiB
Mathematica
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
|