source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD2.m@ 1000

Last change on this file since 1000 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.2 KB
RevLine 
[613]1PSUUD2 ;BIR/TJH - PBM UNIT DOSE SUBROUTINES & FUNCTIONS ;24 DEC 2003
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIA(s)
4 ; Reference to file #55 supported by DBIA 2497
5 ;
6DISAMT ; precompute dispensed amounts by drug
7 N DADATE,DADRUG,DAMT,DAHOW
8 K PSUDAS ; initialize Dispensed Amount Summary array
9 ;*34 |=>
10 S PSUXX=PSUSDT\1-.0001
11DAL134 S PSUXX=$O(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX))
12 G:'PSUXX DISAMTQ
13 I PSUXX>PSUTEDT G DISAMTQ
14 S DISPDA=0
15 F S DISPDA=$O(^PS(55,PSPAT,5,PSDOSE,11,"B",PSUXX,DISPDA)) Q:DISPDA'>0 D
16 . K DISPI
17 . D GETS^PSUTL(55.0611,"PSPAT,PSDOSE,DISPDA",".01;.02;.03;.05","DISPI","I")
18 . D MOVEI^PSUTL("DISPI")
19 . S DADATE=DISPI(.01)
20 . S DADRUG=$G(DISPI(.02)) G:DADRUG="" DAL134
21 . S DAMT=$G(DISPI(.03))
22 . S DAHOW=$G(DISPI(.05))
23 . S PSUDAS(DADRUG)=$G(PSUDAS(DADRUG))+$S(DAHOW=4:DAMT*-1,1:DAMT) ;net
24 . I DAHOW'=4 D
25 ..S PSUDAS("DISP",DADRUG)=$G(PSUDAS("DISP",DADRUG))+$G(DAMT) ;Dispense
26 . I DAHOW=4 D
27 ..S PSUDAS("RET",DADRUG)=$G(PSUDAS("RET",DADRUG))+$G(DAMT) ;Return
28 . S PSUDAS("NET",DADRUG)=$G(PSUDAS("DISP",DADRUG))-$G(PSUDAS("RET",DADRUG)) ;Net dispensed
29 .;
30 . K DISPI
31 G DAL134
32 ;*34 <=|
33DISAMTQ K ^TMP($J,"PSUTA") Q ; exit point from DISAMT subroutine
34 ;
35SETUP ; set up some variables required later
36 D SECTN^PSUTL1
37 D DT^DILF("E",PSUSDT,.EXTD)
38 S PSURP("START")=EXTD(0)
39 D DT^DILF("E",PSUEDT,.EXTD)
40 S PSURP("END")=EXTD(0)
41 S X1=PSUSDT,X2=-101
42 D C^%DTC K %,%H,%T
43 S PSDATE=X
44 S PSUEDTIM=PSUEDT+.2400
45 S PSUJOB=$G(PSUJOB,$J),PSUUDSUB="PSUUD_"_PSUJOB
46 K ^XTMP(PSUUDSUB)
47 K PSUDTLRN
48 S X1=DT,X2=3 D C^%DTC
49 S ^XTMP(PSUUDSUB,0)=X_U_DT_U_"PSU PBM UNIT DOSE STATISTICAL DATA"
50SETUPQ Q ; exit from SETUP
51 ;
52TMPUD ; store Unit Dose data in first half of record, pieces 2-7
53 S DLM="^",REC1="^"
54 S REC1=REC1_$TR(PSUFACN,"^","'")_DLM_$TR(PSUDOSE(10),"^","'")_DLM_$TR(PSUDOSE(.01),"^","'")
55 S REC1=REC1_DLM_PSUSSN_DLM_$TR(PSUDOSE(26),"^","'")_DLM_PSUVSSN ;_DLM_$TR(PSUVCL,"^","'")
56 ;S REC1=REC1_DLM_$TR(PSUVSV,"^","'")_DLM_$TR(PSUVS1,"^","'")_DLM_$TR(PSUVS2,"^","'")
57TMPUDQ Q ; exit from TMPUD
58 ;
59TMPDD ; create Dispense Drug record and store in ^XTMP
60 N PSUDAMT S PSUDAMT=$G(PSUDAS(PSUDISD(.01)))
61 Q:'PSUDAMT ; per Lina B., do not store if dispensed amount=0
62 S DLM="^",REC2="",PSUDTLRN(PSUFACN)=+$G(PSUDTLRN(PSUFACN))+1
63 S REC2=REC1_DLM_$TR(PSUDRUG(21),"^","'")_DLM_$TR(PSUDRUG(2),"^","'")_DLM
64 S REC2=REC2_$TR(PSUDRUG(.01),"^","'")_DLM_$TR(PSUDRUG(31),"^","'")_DLM
65 S REC2=REC2_PSUDRUG(51)_DLM_PSUDNFI_DLM_PSUDNFR_DLM
66 S REC2=REC2_$TR(PSUDISD(.02),"^","'")_DLM_$TR(PSUDRUG(14.5),"^","'")_DLM
67 S REC2=REC2_$TR(PSUDRUG(16),"^","'")_DLM_PSUDAMT_DLM_PSUDRUG(52)_DLM_PSUDRUG(3)_"^"
68 ;VMP OIFO BAY PINES;ELR;PSU*3.0*24
69 D ICN^PSUV1 S PSUPICN=$G(^XTMP("PSU_"_PSUJOB,"PSUPICN"))
70 S REC2=REC2_$G(PSUPICN)_DLM_$G(PSUDOSE(1))_DLM_PSUUDST_DLM
71 ;
72 ;ADD AMIS DATA
73 N PSUDSP,PSURET
74 S PSUDSP=$G(PSUDAS("DISP",PSUDISD(.01)))
75 S ^XTMP(PSUUDSUB,"DISP",PSUFACN)=PSUDSP+$G(^XTMP(PSUUDSUB,"DISP",PSUFACN))
76 S PSURET=$G(PSUDAS("RET",PSUDISD(.01)))
77 S ^XTMP(PSUUDSUB,"RET",PSUFACN)=PSURET+$G(^XTMP(PSUUDSUB,"RET",PSUFACN))
78 S:'$G(PSURET) PSURET=0
79 S REC2=REC2_PSUDSP_DLM_PSURET_DLM
80 ;END AMIS DATA
81 ;
82 S ^XTMP(PSUUDSUB,"DETAIL",PSUFACN,PSUDTLRN(PSUFACN))=REC2
83 ; increase Unit Dose and Patient counts if not already counted
84 I '$D(^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01))) D
85 .S ^XTMP(PSUUDSUB,"ORD",PSUFACN,PSUDOSE(.01))=""
86 .S ^XTMP(PSUUDSUB,"ORD",PSUFACN)=1+$G(^XTMP(PSUUDSUB,"ORD",PSUFACN))
87 I '$D(^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN)) D
88 .S ^XTMP(PSUUDSUB,"SSN",PSUFACN,PSUSSN)=""
89 .S ^XTMP(PSUUDSUB,"SSN",PSUFACN)=1+$G(^XTMP(PSUUDSUB,"SSN",PSUFACN))
90 S PSUDIV=PSUFACN D GETDIV^PSUV3 I PSUDIVNM'="" D
91 .S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)=""
92 I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
93 ; and store totals by drug in ^TMP("PSUUD DRUG",$J,PSUFACN
94 I '$D(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01))) D
95 .S ^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01))=0_U_PSUDRUG(16)_U_PSUDRUG(51)_U_PSUDNFI
96 S $P(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)=$P(^XTMP(PSUUDSUB,"DRUG",PSUFACN,PSUDRUG(.01)),U,1)+PSUDAMT
97 ; and store Summary totals
98 S ^XTMP(PSUUDSUB,"DIS",PSUFACN)=PSUDAMT+$G(^XTMP(PSUUDSUB,"DIS",PSUFACN))
99 S ^XTMP(PSUUDSUB,"CST",PSUFACN)=(PSUDRUG(16)*PSUDAMT)+$G(^XTMP(PSUUDSUB,"CST",PSUFACN))
100TMPDDQ Q ; exit from TMPDD
Note: See TracBrowser for help on using the repository browser.