| 1 | PSUUD1 ;BIR/TJH - PBM UNIT DOSE MODULE ;12 AUG 1999
|
|---|
| 2 | ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
|
|---|
| 3 | ;DBIA(s)
|
|---|
| 4 | ; Reference to file #55 supported by DBIA 2497
|
|---|
| 5 | ; Reference to file #7 supported by DBIA 2495
|
|---|
| 6 | ; Reference to file #50 supported by DBIA 221
|
|---|
| 7 | ; Reference to file #42 supported by DBIA 2440
|
|---|
| 8 | ; Reference to file #40.8 supported by DBIA 2438
|
|---|
| 9 | ; Reference to file #200 supported by DBIA 10060
|
|---|
| 10 | ; Reference to XUA4A72 supported by DBIA 1625
|
|---|
| 11 | ;
|
|---|
| 12 | EN ; Entry point
|
|---|
| 13 | ;
|
|---|
| 14 | N PSUDOC1,PSUUDST
|
|---|
| 15 | D SETUP^PSUUD2 ; set up various arrays, variables needed for processing
|
|---|
| 16 | ;
|
|---|
| 17 | ; loop thru AUD 'stop date' index
|
|---|
| 18 | ; *34 |==>
|
|---|
| 19 | S PSDATE=PSUSDT\1-.0001 ;use 1st date of scan for 'stop date'
|
|---|
| 20 | L1 S PSDATE=$O(^PS(55,"AUD",PSDATE))
|
|---|
| 21 | I (PSDATE="") G STEP2
|
|---|
| 22 | S PSPAT=0,PSUTEDT=PSUEDT\1+.2359
|
|---|
| 23 | L2 ; loop thru patient within date
|
|---|
| 24 | S PSPAT=$O(^PS(55,"AUD",PSDATE,PSPAT))
|
|---|
| 25 | ; <==| *34
|
|---|
| 26 | G:PSPAT'?1.N L1
|
|---|
| 27 | ; SCREEN OUT TEST PATIENTS
|
|---|
| 28 | G:$$TESTPAT^PSUTL1(PSPAT) L2
|
|---|
| 29 | S PSDOSE=0
|
|---|
| 30 | L3 ; loop thru unit dose entries within patient
|
|---|
| 31 | S PSDOSE=$O(^PS(55,"AUD",PSDATE,PSPAT,PSDOSE))
|
|---|
| 32 | G:PSDOSE'?1.N L2
|
|---|
| 33 | I '$D(^PS(55,PSPAT,5,PSDOSE,11)) G L3 ;*34
|
|---|
| 34 | S ^XTMP("PSU_"_PSUJOB,"PSUHLD",PSDOSE)=""
|
|---|
| 35 | K PSUDOSE
|
|---|
| 36 | S XX=$$VALI^PSUTL(55.06,"PSPAT,PSDOSE",10) ;*34
|
|---|
| 37 | I (XX\1)>PSUTEDT G L3 ;*34
|
|---|
| 38 | ;
|
|---|
| 39 | D GETS^PSUTL(55.06,"PSPAT,PSDOSE",".01;.5;1;9;10;26;34;68","PSUDOSE","I")
|
|---|
| 40 | D MOVEI^PSUTL("PSUDOSE")
|
|---|
| 41 | ;.01=order number, .5=patient ptr, 1=provider ptr, 9=original ward
|
|---|
| 42 | ;10=start date/time, 26=schedule, 34=stop date/time, 68=last ward
|
|---|
| 43 | S PSUUDST=PSUDOSE(34)\1
|
|---|
| 44 | S PSUDOSE(10)=$P(PSUDOSE(10),".",1)
|
|---|
| 45 | S DFN=PSUDOSE(.5) D PID^VADPT
|
|---|
| 46 | S PSUSSN=$TR(VA("PID"),"^-","'")
|
|---|
| 47 | I $G(PSUSSN) S ^XTMP("PSU_"_PSUJOB,"PSUTDFN",DFN,PSUSSN)=""
|
|---|
| 48 | S PSUFACN=PSUSNDR,PSUX=$S($L(PSUDOSE(9)):PSUDOSE(9),1:PSUDOSE(68))
|
|---|
| 49 | I $L(PSUX) D
|
|---|
| 50 | .S PSUX1=$$VALI^PSUTL(42,PSUX,.015)
|
|---|
| 51 | .I PSUX1'="" S PSUFACN=$$VALI^PSUTL(40.8,PSUX1,1)
|
|---|
| 52 | PROV ; collect provider data
|
|---|
| 53 | S (PSUVCL,PSUVS1,PSUVS2)=""
|
|---|
| 54 | S PSUVSSN=$$VALI^PSUTL(200,PSUDOSE(1),9)
|
|---|
| 55 | I PSUVSSN="" S PSUVSSN=999999999
|
|---|
| 56 | S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUVSSN,PSUDOSE(1))=""
|
|---|
| 57 | S PSUDOC(9)=PSUVSSN
|
|---|
| 58 | ;
|
|---|
| 59 | S PSUVCP=$$VALI^PSUTL(200,PSUDOSE(1),53.5) ; class pointer
|
|---|
| 60 | I PSUVCP'="" D
|
|---|
| 61 | .S PSUVCL=$$VALI^PSUTL(7,PSUVCP,1)
|
|---|
| 62 | .I PSUVCL="" S PSUVCL=$$VALI^PSUTL(7,PSUVCP,.01)
|
|---|
| 63 | S PSUVSV=$$VAL^PSUTL(200,PSUDOSE(1),29) ; points to # 49,.01
|
|---|
| 64 | S PSUVSVX=$$UPPER^PSUTL(PSUVSV),PSUVSV=""
|
|---|
| 65 | I $L(PSUVSVX),$D(PSECT(PSUVSVX)) S PSUVSV=PSECT(PSUVSVX) ; convert to abbrev. if found in list.
|
|---|
| 66 | S PSUSPSTR=$$GET^XUA4A72(PSUDOSE(1),PSDATE)
|
|---|
| 67 | S PSUVS1=$P(PSUSPSTR,U,3),PSUVS2=$P(PSUSPSTR,U,4)
|
|---|
| 68 | K PSUDAS D DISAMT^PSUUD2 ; set up dispensed amount summary array PSUDAS ;*34
|
|---|
| 69 | D TMPUD^PSUUD2 ; store Unit Dose info in REC1
|
|---|
| 70 | DISD ; Dispense Drug 55.06,2 Mult --> 55.07 ^PS(55,PAT,5,DOSE,1,DISP,0)
|
|---|
| 71 | S PSUDDX=0
|
|---|
| 72 | DISDL1 S PSUDDX=$O(^PS(55,PSPAT,5,PSDOSE,1,PSUDDX)) G:PSUDDX'?1.N DISDX
|
|---|
| 73 | ;
|
|---|
| 74 | D GETS^PSUTL(55.07,"PSPAT,PSDOSE,PSUDDX",".01;.02;.03","PSUDISD","I")
|
|---|
| 75 | ; .01 = drug pointer, .02 = units per dose, .03 = inactive date
|
|---|
| 76 | D MOVEI^PSUTL("PSUDISD")
|
|---|
| 77 | I $G(PSUDISD(.01))="" G DISDL1 ; missing data, go back and try another
|
|---|
| 78 | I $L(PSUDISD(.03)),PSUDISD(.03)<PSUSDT G DISDL1
|
|---|
| 79 | ;
|
|---|
| 80 | ;
|
|---|
| 81 | S:PSUDISD(.02)="" PSUDISD(.02)=1 ; default to 1 if not filled per Lina B.
|
|---|
| 82 | D GETS^PSUTL(50,PSUDISD(.01),".01;2;14.5;16;20;21;22;25;31;51;52;3","PSUDRUG","I")
|
|---|
| 83 | I '$D(PSUDRUG) F I=.01,2,14.5,16,20,21,22,25,31,51,52,3 S PSUDRUG(I,"I")=""
|
|---|
| 84 | D MOVEI^PSUTL("PSUDRUG")
|
|---|
| 85 | I PSUDRUG(.01)="" S PSUDRUG(.01)="Unknown Generic Name"
|
|---|
| 86 | I PSUDRUG(21)="" S PSUDRUG(21)="Unknown VA Product Name"
|
|---|
| 87 | I PSUDRUG(31)="" S PSUDRUG(31)="No NDC"
|
|---|
| 88 | I PSUDRUG(51)=1 S PSUDRUG(51)="N/F"
|
|---|
| 89 | I PSUDRUG(52) S PSUDRUG(52)="N/F"
|
|---|
| 90 | S PSUDNFI="",PSUDNFR="" ; National Formulary Indicator & Restriction
|
|---|
| 91 | I $$VERSION^XPDUTL("PSN")'<4 D ; check for v.4 or greater of NDF
|
|---|
| 92 | .S PSUDNFI=$$FORMI^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
|
|---|
| 93 | .S PSUDNFR=$$FORMR^PSNAPIS(PSUDRUG(20),PSUDRUG(22))
|
|---|
| 94 | D TMPDD^PSUUD2 ; store dispense drug data in ^XTMP global
|
|---|
| 95 | D LAB^PSULR0("UD",PSUFACN,PSUDOSE(.01),PSUDOSE(.5),PSUDRUG(.01),PSUDRUG(2))
|
|---|
| 96 | G DISDL1
|
|---|
| 97 | DISDX ; end of dispense drug, go back for next one.
|
|---|
| 98 | G L3
|
|---|
| 99 | ;
|
|---|
| 100 | STEP2 ; done with data collection, go back to ^PSUUD0
|
|---|
| 101 | Q
|
|---|
