248 lines
8.7 KiB
Mathematica
248 lines
8.7 KiB
Mathematica
PSUV1 ;BIR/CFL - Extract Data of PBM IV Module ;25 AUG 1998
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|
;DBIAs
|
|
; Reference to file #55 supported by DBIA 2497
|
|
; Reference to file #59.5 supported by DBIA 2499
|
|
; Reference to file #40.8 supported by DBIA 2438
|
|
; Reference to file #7 supported by DBIA 2495
|
|
; Reference to file #49 supported by DBIA 10093
|
|
; Reference to file #52.6 supported by DBIA 436
|
|
; Reference to file #50 supported by DBIA 221
|
|
; Reference to file #52.7 supported by DBIA 437
|
|
; Reference to file #2 supported by DBIA 10035 and 2701
|
|
; Reference to file #200 supported by DBIA 10060
|
|
;
|
|
IVDATA ;Loop through IV data
|
|
N PSUDOC1
|
|
K PSUSSNA,PSUORDA
|
|
; *34 |==>
|
|
S PSUIVDT=PSUSDT\1-.0001 ;use 1st day of extract for 'stop date' scan
|
|
S PSUTEDT=PSUEDT\1+.2359
|
|
F S PSUIVDT=$O(^PS(55,"AIV",PSUIVDT)) Q:'PSUIVDT D
|
|
.S PSUPDA=""
|
|
.F S PSUPDA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA)) Q:'PSUPDA D
|
|
..S PSUODA=""
|
|
..F S PSUODA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA,PSUODA)) Q:'PSUODA D
|
|
...S ^XTMP("PSU_"_PSUJOB,"PSUHLD",PSUODA)="" ;should be the D0's for file 55.01 ; <==| *34
|
|
...S COUNT=0
|
|
...S PSUDIV=""
|
|
...K PSUIV
|
|
...; screen test patients
|
|
...Q:$$TESTPAT^PSUTL1(PSUPDA)
|
|
...S XX=$$VALI^PSUTL(55.01,"PSUPDA,PSUODA",.02) Q:XX>PSUTEDT ;*34
|
|
...K PSUIV ;*34
|
|
...D GETS^PSUTL(55.01,"PSUPDA,PSUODA",".01;.02;.03;.04;.06;.08;.09;.22;104;106;108","PSUIV","I")
|
|
...;.01-Order num;.02-Start Dt;.03-Stop Dt;.04-Type;.06-Provider
|
|
...;104-Ward;106-Chemotherapy Type;108-Intermittent Syringe
|
|
...Q:'$D(PSUIV)
|
|
...;VMP OIFO BAY PINES;ELR;PSU*3*35 ADDED NEXT LINE
|
|
...Q:$G(PSUIV(.06,"I"))'>0
|
|
...S ^XTMP("PSU_"_PSUJOB,"PSUPIEN",PSUPDA)="" ;Patient IEN's ;*34
|
|
...D MOVEI^PSUTL("PSUIV")
|
|
...S PSUIV(.02)=PSUIV(.02)\1
|
|
...S PSUIV(.03)=PSUIV(.03)\1
|
|
...I PSUIV(.22)'="" S PSUDIV=$$VALI^PSUTL(59.5,PSUIV(.22),.02)
|
|
...S PSUFAC=$$VALI^PSUTL(40.8,PSUDIV,1) S:PSUFAC="" PSUFAC=PSUSNDR
|
|
...S PSUFAC(PSUFAC)=""
|
|
...S PSUOUTP=$S(PSUIV(104)=.5:"Y",1:"N")
|
|
...S DFN=PSUPDA D PID^VADPT
|
|
...S PSUSSN=$TR(VA("PID"),"^-","")
|
|
...D ICN
|
|
...K PSUDOC
|
|
...D GETS^PSUTL(200,"PSUIV(.06)","9;29;53.5","PSUDOC","I")
|
|
...D MOVEI^PSUTL("PSUDOC")
|
|
...I $G(PSUDOC(9))="" S PSUVSSN1=999999999
|
|
...I $G(PSUDOC(9))'="" S PSUVSSN1=PSUDOC(9)
|
|
...S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUVSSN1,PSUIV(.06))=""
|
|
...S (PSUPCLS,PSUSP1,PSUSP2)=""
|
|
...I $D(PSUDOC(53.5)),PSUDOC(53.5)'="" D
|
|
....S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),1)
|
|
....I PSUPCLS="" S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),.01)
|
|
...S PSUPSV=$S($L($G(PSUDOC(29))):$$VAL^PSUTL(49,PSUDOC(29),.01),1:"")
|
|
...S PSUPSV=$$UPPER^PSUTL(PSUPSV),PSUSERV=""
|
|
...I $L(PSUPSV),$D(PSECT(PSUPSV)) S PSUSERV=PSECT(PSUPSV)
|
|
...S SPECPTR=$$GET^XUA4A72(PSUIV(.06),PSUIVDT)
|
|
...S PSUSP1=$P($G(SPECPTR),U,3),PSUSP2=$P($G(SPECPTR),U,4)
|
|
...D OCCAMT
|
|
...I PSUFND D
|
|
....D GETRATE^PSUV2(PSUIV(.04))
|
|
....D SETTOT
|
|
....S RECTYP=""
|
|
....D ADDTIV
|
|
....D SOLUTN
|
|
I $D(^XTMP(PSUIVSUB,"RECORDS")) D SETSUM^PSUV2
|
|
Q
|
|
;
|
|
ICN ;Find patient ICN
|
|
;
|
|
N PSUPICN,PSUPICN1,PSUICN
|
|
S PSUPTN=0
|
|
I $G(PSUSSN),PSUSSN'="" D
|
|
.F S PSUPTN=$O(^DPT("SSN",PSUSSN,PSUPTN)) Q:PSUPTN="" D
|
|
..S PSUPICN1=$$GETICN^MPIF001(PSUPTN) D
|
|
...I PSUPICN1'[-1 D
|
|
....S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=PSUPICN1
|
|
...I PSUPICN1[-1 S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=""
|
|
Q
|
|
;
|
|
;
|
|
OCCAMT ;Calculate the number of dispensing occurrences
|
|
S (PSUFND,PSUDISP,PSUPULL,OCC,PSUDISPT,PSURECT,PSUDEST,PSUCAN)=0
|
|
F S OCC=$O(^PS(55,PSUPDA,"IV",PSUODA,"LAB",OCC)) Q:'OCC D
|
|
.K PSUOCC
|
|
.D GETS^PSUTL(55.1111,"PSUPDA,PSUODA,OCC","1;2;4;6","PSUOCC","I")
|
|
.D MOVEI^PSUTL("PSUOCC")
|
|
.S PSUOCC(1)=PSUOCC(1)\1
|
|
.I PSUOCC(1)<PSUSDT!(PSUOCC(1)>PSUTEDT) Q ;*34
|
|
.S PSUFND=1
|
|
.I $G(PSUOCC(6))=1,$G(PSUOCC(2))=1 D
|
|
..S PSUDISP=PSUDISP+$G(PSUOCC(4))
|
|
..S PSUDISPT=PSUDISP ;Total IV dispensed
|
|
..S PSUPULL=PSUPULL+$G(PSUOCC(4))
|
|
..S ^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC)=PSUOCC(4)+$G(^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC))
|
|
..I PSUOUTP="Y" D ; Total outpatient IV's dispensed
|
|
...S ^XTMP(PSUIVSUB,"ODISP",PSUFAC)=$G(^XTMP(PSUIVSUB,"ODISP",PSUFAC))+PSUOCC(4)
|
|
.;I PSUOCC(2)=2!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4)
|
|
.I PSUOCC(6)=1,PSUOCC(2)=2 D
|
|
..S PSURECT=$G(PSURECT)+PSUOCC(4) ;Total IV Recycled
|
|
.I PSUOCC(6)=1,PSUOCC(2)=3 D
|
|
..S PSUDEST=$G(PSUDEST)+PSUOCC(4) ;Total IV Destroyed
|
|
.I PSUOCC(6)=1,PSUOCC(2)=4 D
|
|
..S PSUCAN=$G(PSUCAN)+PSUOCC(4) ;Total IV Cancelled
|
|
.I PSUOCC(6)=1 D
|
|
..I (PSUOCC(2)=2)!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4) ;Net disp
|
|
Q
|
|
SETTOT ;Set totals
|
|
; Total number of IV's ordered
|
|
S ^XTMP(PSUIVSUB,"ORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"ORD",PSUFAC))+1
|
|
; Total number of IV patients
|
|
I '$D(^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)) D
|
|
.S ^XTMP(PSUIVSUB,"SSN",PSUFAC)=$G(^XTMP(PSUIVSUB,"SSN",PSUFAC))+1
|
|
.S ^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)=""
|
|
.S PSUDIV=PSUFAC D GETDIV^PSUV3 I PSUDIVNM'="" D
|
|
..S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)="" ;Pt demo summary
|
|
.I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
|
|
I PSUOUTP="Y" D
|
|
.; Total outpatient IV's ordered
|
|
.S ^XTMP(PSUIVSUB,"OORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"OORD",PSUFAC))+1
|
|
Q
|
|
ADDTIV ;Loop through each additive
|
|
S (PSUNITS,ADTIV)=0
|
|
F S ADTIV=$O(^PS(55,PSUPDA,"IV",PSUODA,"AD",ADTIV)) Q:'ADTIV D
|
|
.K PSUADDTV,PSUGNRIC,PSUADD
|
|
.D GETS^PSUTL(55.02,"PSUPDA,PSUODA,ADTIV",".01;.02","PSUADDTV","I")
|
|
.D MOVEI^PSUTL("PSUADDTV")
|
|
.D GETS^PSUTL(52.6,"PSUADDTV(.01)",".01;1;7","PSUGNRIC","I")
|
|
.D MOVEI^PSUTL("PSUGNRIC")
|
|
.S PSUPNAM=PSUGNRIC(.01)
|
|
.S PSUDGU=$$VAL^PSUTL(52.6,PSUADDTV(.01),2)
|
|
.S PSUDGDA=PSUGNRIC(1)
|
|
.D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","PSUADD","I")
|
|
.D MOVEI^PSUTL("PSUADD")
|
|
.S PSUGNM=PSUADD(.01)
|
|
.S PSUDCLS=PSUADD(2)
|
|
.S PSUPRNM=PSUADD(21)
|
|
.S PSUNDC=PSUADD(31)
|
|
.S PSUNFI=PSUADD(51)
|
|
.S PSUNADR=PSUADD(20)
|
|
.S PSUNDCL=PSUADD(22)
|
|
.S PSUDEA=PSUADD(3)
|
|
.S PSUNAF=$S(PSUADD(52):"N/F",1:"")
|
|
.D SETVAR
|
|
.S PSUSTRN=+PSUADDTV(.02)
|
|
.;
|
|
.;DAM Add AMIS Additive data
|
|
.N PSUTDSP1
|
|
.S PSUTDSP1=$G(PSUDISPT)*PSUSTRN ;Total Additive units dispens
|
|
.;
|
|
.N PSURCY1
|
|
.S PSURCY1=$G(PSURECT)*PSUSTRN ;Total Additive units recycled
|
|
.;
|
|
.N PSUDES1
|
|
.S PSUDES1=$G(PSUDEST)*PSUSTRN ;Total Additive units destroyed
|
|
.;
|
|
.N PSUCAN1
|
|
.S PSUCAN1=$G(PSUCAN)*PSUSTRN ;Total Additive units cancelled
|
|
.;END DAM
|
|
.S PSUNITS=PSUDISP*PSUSTRN
|
|
.S PSUBAGS=PSUPULL*PSUSTRN
|
|
.S PSUDCST=PSUGNRIC(7)
|
|
.S RECIND="A"
|
|
.D CALC
|
|
.D SETREC^PSUV2
|
|
.D SETDRUG^PSUV2
|
|
Q
|
|
SOLUTN ;Loop through each solution
|
|
S (PSUNITS,SOLDA)=0 F S SOLDA=$O(^PS(55,PSUPDA,"IV",PSUODA,"SOL",SOLDA)) Q:'SOLDA D
|
|
.K PSUSOL,GENRIC,SOLDRUG
|
|
.D GETS^PSUTL(55.11,"PSUPDA,PSUODA,SOLDA",".01;1","PSUSOL","I")
|
|
.D MOVEI^PSUTL("PSUSOL")
|
|
.D GETS^PSUTL(52.7,"PSUSOL(.01)",".01;1;7","GENRIC","I")
|
|
.D MOVEI^PSUTL("GENRIC")
|
|
.S PSUPNAM=GENRIC(.01)
|
|
.S PSUDGU="ML"
|
|
.S PSUDGDA=GENRIC(1)
|
|
.D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","SOLDRUG","I")
|
|
.D MOVEI^PSUTL("SOLDRUG")
|
|
.S PSUGNM=SOLDRUG(.01)
|
|
.S PSUDCLS=SOLDRUG(2)
|
|
.S PSUPRNM=SOLDRUG(21)
|
|
.S PSUNDC=SOLDRUG(31)
|
|
.S PSUNFI=SOLDRUG(51)
|
|
.S PSUNADR=SOLDRUG(20)
|
|
.S PSUNDCL=SOLDRUG(22)
|
|
.S PSUDEA=SOLDRUG(3)
|
|
.S PSUNAF=$S(SOLDRUG(52):"N/F",1:"")
|
|
.D SETVAR
|
|
.S VOLUME=+PSUSOL(1)
|
|
.;
|
|
.;DAM ADD AMIS SOLUTION DATA
|
|
.N PSUTSOL1
|
|
.S PSUTSOL1=$G(PSUDISPT)*VOLUME ;Total Solution units dispense
|
|
.;
|
|
.N PSUTRS1
|
|
.S PSUTRS1=$G(PSURECT)*VOLUME ;Total Solution units recycl
|
|
.;
|
|
.N PSUTDS1
|
|
.S PSUTDS1=$G(PSUDEST)*VOLUME ;Total Solution units destroyed
|
|
.;
|
|
.N PSUTCS1
|
|
.S PSUTCS1=$G(PSUCAN)*VOLUME ;Total Solution units cancelled
|
|
.;END DAM
|
|
.S PSUNITS=PSUDISP*VOLUME
|
|
.S PSUBAGS=PSUPULL*VOLUME
|
|
.S PSUDCST=GENRIC(7)
|
|
.S RECIND="S"
|
|
.D CALC
|
|
.D SETREC^PSUV2
|
|
.D SETDRUG^PSUV2
|
|
Q
|
|
SETVAR ;Setup common variables for IV Additives and Solutions
|
|
I PSUGNM="" S PSUGNM="UNKNOWN GENERIC NAME"
|
|
I PSUPRNM="" S PSUPRNM="UNKNOWN VA PRODUCT NAME"
|
|
I PSUNDC="" S PSUNDC="No NDC"
|
|
I PSUNFI=1 S PSUNFI="N/F"
|
|
S (PSIVNFI,PSIVNFR)=""
|
|
I $$VERSION^XPDUTL("PSN")'<4 D
|
|
.S PSIVNFI=$$FORMI^PSNAPIS(PSUNADR,PSUNDCL)
|
|
.S PSIVNFR=$$FORMR^PSNAPIS(PSUNADR,PSUNDCL)>0
|
|
Q
|
|
CALC ;Do calculations for additives and solutions
|
|
S ^XTMP(PSUIVSUB,"CST",PSUFAC)=(PSUNITS*PSUDCST)+$G(^XTMP(PSUIVSUB,"CST",PSUFAC))
|
|
S RECTYP=""
|
|
S COUNT=COUNT+1
|
|
S:COUNT=1 RECTYP="P"
|
|
I PSUOUTP="Y" D
|
|
.S ^XTMP(PSUIVSUB,"OCST",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"OCST",PSUFAC))
|
|
I PSUIV(.04)="P" D
|
|
.S ^XTMP(PSUIVSUB,"SPIG",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SPIG",PSUFAC))
|
|
I PSUIV(.04)="A" D
|
|
.S ^XTMP(PSUIVSUB,"SADM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SADM",PSUFAC))
|
|
I PSUIV(.04)="H" D
|
|
.S ^XTMP(PSUIVSUB,"SHYP",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SHYP",PSUFAC))
|
|
I PSUIV(.04)="S" D
|
|
.S ^XTMP(PSUIVSUB,"SSYR",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SSYR",PSUFAC))
|
|
I PSUIV(.04)="C" D
|
|
.S ^XTMP(PSUIVSUB,"SCHEM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SCHEM",PSUFAC))
|
|
Q
|