102 lines
4.0 KiB
Mathematica
102 lines
4.0 KiB
Mathematica
PSUUD1 ;BIR/TJH - PBM UNIT DOSE MODULE ;12 AUG 1999
|
|
;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|
;DBIA(s)
|
|
; Reference to file #55 supported by DBIA 2497
|
|
; Reference to file #7 supported by DBIA 2495
|
|
; Reference to file #50 supported by DBIA 221
|
|
; Reference to file #42 supported by DBIA 2440
|
|
; Reference to file #40.8 supported by DBIA 2438
|
|
; Reference to file #200 supported by DBIA 10060
|
|
; Reference to XUA4A72 supported by DBIA 1625
|
|
;
|
|
EN ; Entry point
|
|
;
|
|
N PSUDOC1,PSUUDST
|
|
D SETUP^PSUUD2 ; set up various arrays, variables needed for processing
|
|
;
|
|
; loop thru AUD 'stop date' index
|
|
; *34 |==>
|
|
S PSDATE=PSUSDT\1-.0001 ;use 1st date of scan for 'stop date'
|
|
L1 S PSDATE=$O(^PS(55,"AUD",PSDATE))
|
|
I (PSDATE="") G STEP2
|
|
S PSPAT=0,PSUTEDT=PSUEDT\1+.2359
|
|
L2 ; loop thru patient within date
|
|
S PSPAT=$O(^PS(55,"AUD",PSDATE,PSPAT))
|
|
; <==| *34
|
|
G:PSPAT'?1.N L1
|
|
; SCREEN OUT TEST PATIENTS
|
|
G:$$TESTPAT^PSUTL1(PSPAT) L2
|
|
S PSDOSE=0
|
|
L3 ; loop thru unit dose entries within patient
|
|
S PSDOSE=$O(^PS(55,"AUD",PSDATE,PSPAT,PSDOSE))
|
|
G:PSDOSE'?1.N L2
|
|
I '$D(^PS(55,PSPAT,5,PSDOSE,11)) G L3 ;*34
|
|
S ^XTMP("PSU_"_PSUJOB,"PSUHLD",PSDOSE)=""
|
|
K PSUDOSE
|
|
S XX=$$VALI^PSUTL(55.06,"PSPAT,PSDOSE",10) ;*34
|
|
I (XX\1)>PSUTEDT G L3 ;*34
|
|
;
|
|
D GETS^PSUTL(55.06,"PSPAT,PSDOSE",".01;.5;1;9;10;26;34;68","PSUDOSE","I")
|
|
D MOVEI^PSUTL("PSUDOSE")
|
|
;.01=order number, .5=patient ptr, 1=provider ptr, 9=original ward
|
|
;10=start date/time, 26=schedule, 34=stop date/time, 68=last ward
|
|
S PSUUDST=PSUDOSE(34)\1
|
|
S PSUDOSE(10)=$P(PSUDOSE(10),".",1)
|
|
S DFN=PSUDOSE(.5) D PID^VADPT
|
|
S PSUSSN=$TR(VA("PID"),"^-","'")
|
|
I $G(PSUSSN) S ^XTMP("PSU_"_PSUJOB,"PSUTDFN",DFN,PSUSSN)=""
|
|
S PSUFACN=PSUSNDR,PSUX=$S($L(PSUDOSE(9)):PSUDOSE(9),1:PSUDOSE(68))
|
|
I $L(PSUX) D
|
|
.S PSUX1=$$VALI^PSUTL(42,PSUX,.015)
|
|
.I PSUX1'="" S PSUFACN=$$VALI^PSUTL(40.8,PSUX1,1)
|
|
PROV ; collect provider data
|
|
S (PSUVCL,PSUVS1,PSUVS2)=""
|
|
S PSUVSSN=$$VALI^PSUTL(200,PSUDOSE(1),9)
|
|
I PSUVSSN="" S PSUVSSN=999999999
|
|
S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUVSSN,PSUDOSE(1))=""
|
|
S PSUDOC(9)=PSUVSSN
|
|
;
|
|
S PSUVCP=$$VALI^PSUTL(200,PSUDOSE(1),53.5) ; class pointer
|
|
I PSUVCP'="" D
|
|
.S PSUVCL=$$VALI^PSUTL(7,PSUVCP,1)
|
|
.I PSUVCL="" S PSUVCL=$$VALI^PSUTL(7,PSUVCP,.01)
|
|
S PSUVSV=$$VAL^PSUTL(200,PSUDOSE(1),29) ; points to # 49,.01
|
|
S PSUVSVX=$$UPPER^PSUTL(PSUVSV),PSUVSV=""
|
|
I $L(PSUVSVX),$D(PSECT(PSUVSVX)) S PSUVSV=PSECT(PSUVSVX) ; convert to abbrev. if found in list.
|
|
S PSUSPSTR=$$GET^XUA4A72(PSUDOSE(1),PSDATE)
|
|
S PSUVS1=$P(PSUSPSTR,U,3),PSUVS2=$P(PSUSPSTR,U,4)
|
|
K PSUDAS D DISAMT^PSUUD2 ; set up dispensed amount summary array PSUDAS ;*34
|
|
D TMPUD^PSUUD2 ; store Unit Dose info in REC1
|
|
DISD ; Dispense Drug 55.06,2 Mult --> 55.07 ^PS(55,PAT,5,DOSE,1,DISP,0)
|
|
S PSUDDX=0
|
|
DISDL1 S PSUDDX=$O(^PS(55,PSPAT,5,PSDOSE,1,PSUDDX)) G:PSUDDX'?1.N DISDX
|
|
;
|
|
D GETS^PSUTL(55.07,"PSPAT,PSDOSE,PSUDDX",".01;.02;.03","PSUDISD","I")
|
|
; .01 = drug pointer, .02 = units per dose, .03 = inactive date
|
|
D MOVEI^PSUTL("PSUDISD")
|
|
I $G(PSUDISD(.01))="" G DISDL1 ; missing data, go back and try another
|
|
I $L(PSUDISD(.03)),PSUDISD(.03)<PSUSDT G DISDL1
|
|
;
|
|
;
|
|
S:PSUDISD(.02)="" PSUDISD(.02)=1 ; default to 1 if not filled per Lina B.
|
|
D GETS^PSUTL(50,PSUDISD(.01),".01;2;14.5;16;20;21;22;25;31;51;52;3","PSUDRUG","I")
|
|
I '$D(PSUDRUG) F I=.01,2,14.5,16,20,21,22,25,31,51,52,3 S PSUDRUG(I,"I")=""
|
|
D MOVEI^PSUTL("PSUDRUG")
|
|
I PSUDRUG(.01)="" S PSUDRUG(.01)="Unknown Generic Name"
|
|
I PSUDRUG(21)="" S PSUDRUG(21)="Unknown VA Product Name"
|
|
I PSUDRUG(31)="" S PSUDRUG(31)="No NDC"
|
|
I PSUDRUG(51)=1 S PSUDRUG(51)="N/F"
|
|
I PSUDRUG(52) S PSUDRUG(52)="N/F"
|
|
S PSUDNFI="",PSUDNFR="" ; National Formulary Indicator & Restriction
|
|
I $$VERSION^XPDUTL("PSN")'<4 D ; check for v.4 or greater of NDF
|
|
.S PSUDNFI=$$FORMI^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
|
|
.S PSUDNFR=$$FORMR^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
|
|
D TMPDD^PSUUD2 ; store dispense drug data in ^XTMP global
|
|
D LAB^PSULR0("UD",PSUFACN,PSUDOSE(.01),PSUDOSE(.5),PSUDRUG(.01),PSUDRUG(2))
|
|
G DISDL1
|
|
DISDX ; end of dispense drug, go back for next one.
|
|
G L3
|
|
;
|
|
STEP2 ; done with data collection, go back to ^PSUUD0
|
|
Q
|