- 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
- 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
