Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSUUD1

PSUUD1.m

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