source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD2.m@ 628

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