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

APCM11E2.m

Go to the documentation of this file. 
  1. APCM11E2 ; IHS/CMI/LAB - IHS MU ;
  1.  ;;1.0;IHS MU PERFORMANCE REPORTS;**1,2,4,5,6**;MAR 26, 2012;Build 65
  1.  ;;;;;;Build 3
  1. CPOE ;EP - CALCULATE CPOE MEDICATIONS MEASURE
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then check to see if they had any prescription in file 52
  1.  ;with an issue date in the EHR reporting period, if so they are in the
  1.  ;denominator for that provider/facility and then update counter
  1.  ;
  1.  ;if they had any prescription that had a nature of order of electronic
  1.  ;they are in the numerator
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..I $D(APCM100R(APCMP,APCMTIME)) S F=$P(^APCMMUM(APCMIC,0),U,11) D S^APCM11E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 prescriptions issued during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D CPOE1
  1.  .Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D CPOE1
  1.  .Q
  1.  Q
  1. CPOE1 ;
  1.  S APCMHP=$$HADRX(DFN,APCMBDAT,APCMEDAT)
  1.  Q:APCMHP=""  ;no prescriptions with an issue date in report period
  1.  ;set denominator value into field
  1.  S F=$P(^APCMMUM(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))_" RX: "_$$DATE^APCM1UTL($P(APCMHP,U))_";"_$P(APCMHP,U,2)
  1.  ;numerator?
  1.  S APCMEP=$$HADNOEP(DFN,APCMBDAT,APCMEDAT)
  1.  G:APCMEP="" CPOEL
  1.  S APCMVALU=APCMVALU_"|||"_$$DATE^APCM1UTL($P(APCMEP,U))_";"_$P(APCMEP,U,2)_" Order #: "_$P(APCMEP,U,3)_"|||"_$S($P(APCMEP,U,2)]"":1,1:"")
  1.  S F=$P(^APCMMUM(APCMIC,0),U,9)
  1.  D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1. CPOEL D SETLIST^APCM11E1
  1.  Q
  1. HADRX(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
  1.  ;between BD and ED
  1.  I '$G(P) Q ""
  1.  I '$G(BD) Q ""
  1.  I '$G(ED) Q ""
  1.  I '$D(^AUPNPAT(P,0)) Q ""
  1.  NEW EXDT,IFN,ID,G,APCMUD,D,R
  1.  S G=""
  1.  I APCMRPTT=2 G UD
  1.  S EXDT=$$FMADD^XLFDT(BD,-730)
  1.  F  S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"")  S IFN=0 F  S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"")  D:$D(^PSRX(IFN,0))
  1.  .Q:$P($G(^PSRX(IFN,"STA")),"^")=13
  1.  .S ID=$P(^PSRX(IFN,0),U,13)
  1.  .Q:ID<BD
  1.  .Q:ID>ED
  1.  .S G=ID_U_$$VAL^XBDIQ1(52,IFN,.01)
  1.  I G Q G
  1.  I APCMRPTT=1 Q ""
  1. UD ;
  1.  S APCMUD=0,G="" F  S APCMUD=$O(^PS(55,P,5,APCMUD)) Q:APCMUD'=+APCMUD!(G)  D
  1.  .Q:'$D(^PS(55,P,5,APCMUD,0))
  1.  .S D=$P($P(^PS(55,P,5,APCMUD,0),U,14),".")
  1.  .Q:D<BD
  1.  .Q:D>ED
  1.  .S R=$O(^PS(55,P,5,APCMUD,1,0)) Q:'R  ;NO DRUG
  1.  .S R=$P(^PS(55,P,5,APCMUD,1,R,0),U,1)
  1.  .S R=$P(^PSDRUG(R,0),U,1)
  1.  .S G=D_U_"UNIT DOSE: "_R
  1.  I G Q G
  1.  ;IV
  1.  S APCMUD=0,G="" F  S APCMUD=$O(^PS(55,P,"IV",APCMUD)) Q:APCMUD'=+APCMUD!(G)  D
  1.  .Q:'$D(^PS(55,P,"IV",APCMUD,0))
  1.  .S D=$P($P(^PS(55,P,"IV",APCMUD,0),U,2),".")
  1.  .Q:D<BD
  1.  .Q:D>ED
  1.  .S R=$P($G(^PS(55,P,"IV",APCMUD,.2)),U,1)
  1.  .I 'R S R=""
  1.  .I R S R=$P($G(^PS(50.7,R,0)),U,1)
  1.  .S G=D_U_"IV: "_R
  1.  Q G
  1. ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
  1.  I '$G(R) Q ""
  1.  I '$D(^VA(200,R,0)) Q ""
  1.  NEW K,J
  1.  S K=$O(^DIC(19.1,"B","ORES",0))
  1.  S J=$O(^DIC(19.1,"B","ORELSE",0))
  1.  I $D(^VA(200,R,51,K,0)),$P(^VA(200,R,51,K,0),U,3)'>D Q 1
  1.  I $D(^VA(200,R,51,J,0)),$P(^VA(200,R,51,J,0),U,3)'>D Q 1
  1.  Q ""
  1. HADNOEP(P,BD,ED) ;EP - did patient have a RX in file 52 with an issue date
  1.  ;between BD and ED
  1.  I '$G(P) Q ""
  1.  I '$G(BD) Q ""
  1.  I '$G(ED) Q ""
  1.  I '$D(^AUPNPAT(P,0)) Q ""
  1.  NEW EXDT,IFN,ID,O,N,A,B
  1.  S N=""
  1.  I APCMRPTT=2 G UD1
  1.  S EXDT=$$FMADD^XLFDT(BD,-730)
  1.  F  S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(N]"")  S IFN=0 F  S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(N]"")  D:$D(^PSRX(IFN,0))
  1.  .Q:$P($G(^PSRX(IFN,"STA")),"^")=13
  1.  .S ID=$P(^PSRX(IFN,0),U,13)
  1.  .Q:ID<BD
  1.  .Q:ID>ED
  1.  .;check nature of order
  1.  .S O=$P($G(^PSRX(IFN,"OR1")),U,2)  ;order number
  1.  .Q:O=""
  1.  .S B=$P($G(^OR(100,O,0)),U,6)
  1.  .Q:B=""
  1.  .;Q:'$$ORES(B,ID)
  1.  .S A=0 F  S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"")  D
  1.  ..Q:'$D(^OR(100,O,8,A,0))
  1.  ..S B=$P(^OR(100,O,8,A,0),U,12)
  1.  ..Q:B=1
  1.  ..Q:B=""
  1.  ..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
  1.  I N Q N
  1.  I APCMRPTT=1 Q ""
  1. UD1 ;
  1.  S G="",N=""
  1.  S APCMUD=0 F  S APCMUD=$O(^PS(55,P,5,APCMUD)) Q:APCMUD'=+APCMUD!(N]"")  D
  1.  .Q:'$D(^PS(55,P,5,APCMUD,0))
  1.  .S D=$P($P(^PS(55,P,5,APCMUD,0),U,14),".")
  1.  .Q:D<BD
  1.  .Q:D>ED
  1.  .;GET ORDER #
  1.  .S O=$P($P(^PS(55,P,5,APCMUD,0),U,21),";")
  1.  .Q:O=""
  1.  .S B=$P($G(^OR(100,O,0)),U,6)
  1.  .Q:B=""
  1.  .;Q:'$$ORES(B,D)
  1.  .S A=0 F  S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"")  D
  1.  ..Q:'$D(^OR(100,O,8,A,0))
  1.  ..S B=$P(^OR(100,O,8,A,0),U,12)
  1.  ..Q:B=1
  1.  ..Q:B=""
  1.  ..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
  1.  I N Q N
  1.  ;CHECK IV
  1.  S G="",N=""
  1.  S APCMUD=0 F  S APCMUD=$O(^PS(55,P,"IV",APCMUD)) Q:APCMUD'=+APCMUD!(N]"")  D
  1.  .Q:'$D(^PS(55,P,"IV",APCMUD,0))
  1.  .S D=$P($P(^PS(55,P,"IV",APCMUD,0),U,2),".")
  1.  .Q:D<BD
  1.  .Q:D>ED
  1.  .;GET ORDER #
  1.  .S O=$P($P(^PS(55,P,"IV",APCMUD,0),U,21),";")
  1.  .Q:O=""
  1.  .S B=$P($G(^OR(100,O,0)),U,6)
  1.  .Q:B=""
  1.  .;Q:'$$ORES(B,D)
  1.  .S A=0 F  S A=$O(^OR(100,O,8,A)) Q:A'=+A!(N]"")  D
  1.  ..Q:'$D(^OR(100,O,8,A,0))
  1.  ..S B=$P(^OR(100,O,8,A,0),U,12)
  1.  ..Q:B=1
  1.  ..Q:B=""
  1.  ..S N=$P($P(^OR(100,O,8,A,0),U),".")_U_$P(^ORD(100.02,B,0),U,1)_U_$P(^OR(100,O,0),U)
  1.  I N Q N
  1.  Q ""
  1. DEMO ;EP - CALCULATE DEMOGRAPHICS
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then check to see if they had dob, preferred language, gender, race, ethnicity recorded
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;DID NOT SEE THIS PATIENT
  1.  ..D DEMO1
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D DEMO1
  1.  .Q
  1.  Q
  1. DEMO1 ;set denominator value into field
  1.  S F=$P(^APCMMUM(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$G(APCMVDOD))
  1.  S APCMVALU=APCMVALU_"|||"_$S($P(APCMEP,U,1)=1:"METS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCMMUM(APCMIC,0),U,9)
  1.  D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM11E1
  1.  Q
  1. HASDEMO(P,BD,ED,T,DODV) ;
  1.  NEW PL,G,R,E,D,C,Y,X,B,Z
  1.  S C=0
  1.  S T=$G(T)
  1.  S DODV=$G(DODV)
  1.  S (PL,G,R,E,D)=""
  1.  ;preferred language
  1.  S X=0 F  S X=$O(^AUPNPAT(P,86,X)) Q:X'=+X!(PL]"")  D
  1.  .S B=$P(^AUPNPAT(P,86,X,0),U)
  1.  .Q:B>ED
  1.  .S C=C+1,PL="Preferred Language"
  1.  S G=$P(^DPT(P,0),U,2) I G]"" S C=C+1,G="Gender"
  1.  S R=""
  1.  I $T(RACE^AGUTL)]"" S R=$$RACE^AGUTL(P)
  1.  I R S C=C+1,R="Race" I 1
  1.  E  S R=$$VAL^XBDIQ1(2,P,.06) I R]"" S C=C+1,R="Race"
  1.  S Z=0 F  S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"")  D
  1.  .S E=$P($G(^DPT(P,.06,Z,0)),U,1)
  1.  .Q:E=""
  1.  .S E="Ethnicity",C=C+1
  1.  .Q
  1.  I $P(^DPT(P,0),U,3)]"" S D="DOB",C=C+1
  1.  I T=2,$G(DODV) G HASDEMOH
  1.  I C=5 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
  1.  Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
  1. HASDEMOH ;did patient die in the hospital during report period?  if so is dod and underlying cause there?
  1.  NEW VDOD,L,UCD
  1.  S UCD=""
  1.  S VDOD=$$DOD^AUPNPAT(P)
  1.  I VDOD]"" S C=C+1,VDOD="DOD"
  1.  S L=$$VAL^XBDIQ1(9000001,P,1114)
  1.  I L]"" S C=C+1,UCD="UCD"
  1.  I C=7 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
  1.  Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_UCD
  1.  ;
  1. PL ;EP - CALCULATE PROBLEM LIST
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;if so, then check to see if they any problems on their problem list (skip deleted) or a NAP documented in report period
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D PL1
  1.  ..Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D PL1
  1.  .Q
  1.  Q
  1. PL1 ;set denominator value into field
  1.  S F=$P(^APCMMUM(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
  1.  S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCMMUM(APCMIC,0),U,9)
  1.  D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM11E1
  1.  Q
  1. HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
  1.  ;
  1.  NEW A,B,C,D,E
  1.  S E=""
  1.  S A=0 F  S A=$O(^AUPNPROB("AC",P,A)) Q:A'=+A!(E]"")  D
  1.  .;if date entered is after the ED don't count it
  1.  .Q:'$D(^AUPNPROB(A,0))
  1.  .Q:$P(^AUPNPROB(A,0),U,8)>ED  ;after end date of report period
  1.  .I $P(^AUPNPROB(A,0),U,12)'="D" S E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08) Q
  1.  .;since it's deleted, deletion date must not be before time period
  1.  .S D=$P($P($G(^AUPNPROB(A,2)),U,2),".")  ;date deleted
  1.  .Q:D>ED
  1.  .Q:D<BD
  1.  .S E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
  1.  I E]"" Q E
  1.  ;no problems on PL so how about a NAP before end of time period
  1.  S C=$O(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
  1.  I 'C Q ""
  1.  S A=0 F  S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(E]"")  D
  1.  .Q:'$D(^AUPNVRUP(A,0))  ;oops
  1.  .Q:$P(^AUPNVRUP(A,0),U,1)'=C  ;not NAP
  1.  .S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
  1.  .Q:D>ED
  1.  .S E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
  1.  Q E
  1. MEDL ;EP - CALCULATE MEDICATION LIST
  1.  ;for each provider or for the facility find out if this
  1.  ;patient had a visit of A, O, R, S to this provider or facility
  1.  ;d
  1.  NEW APCMP
  1.  S (APCMD1,APCMN1)=0
  1.  I APCMRPTT=1 D  Q
  1.  .S APCMP=0 F  S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP  D
  1.  ..Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
  1.  ..D MEDL1
  1.  ..Q
  1.  .Q
  1.  I APCMRPTT=2 D
  1.  .S APCMP=APCMFAC
  1.  .Q:'$D(APCMHVTP(APCMP))
  1.  .D MEDL1
  1.  .Q
  1.  Q
  1. MEDL1 ;set denominator value into field
  1.  S F=$P(^APCMMUM(APCMIC,0),U,8)  ;denom field for this measure
  1.  D S^APCM11E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
  1.  S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
  1.  ;numerator?
  1.  S APCMEP=$$HASML(DFN,APCMBDAT,APCMEDAT)
  1.  S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
  1.  S F=$P(^APCMMUM(APCMIC,0),U,9)
  1.  D S^APCM11E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
  1.  D SETLIST^APCM11E1
  1.  Q
  1. HASML(P,BDT,EDT) ;EP
  1.  N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365
  1.  ;between BD and ED
  1.  I '$G(P) Q ""
  1.  I '$G(BDT) Q ""
  1.  I '$G(EDT) Q ""
  1.  I '$D(^AUPNPAT(P,0)) Q ""
  1.  S G=""
  1. NAM ;look for "No Active Medications" anytime during the report period
  1.  S C=$O(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))
  1.  I 'C G RXS
  1.  ;GET most recent visit date
  1.  S A=0 F  S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(G]"")  D
  1.  .Q:'$D(^AUPNVRUP(A,0))  ;oops
  1.  .Q:$P(^AUPNVRUP(A,0),U,1)'=C  ;not NAM
  1.  .S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
  1.  .Q:D<BDT  ;before beg date
  1.  .Q:D>EDT  ;after end date
  1.  .S G="1^No Active Medications on "_$$DATE^APCM1UTL(D)
  1.  I G Q G
  1. RXS ;
  1.  S G=""
  1.  S D365=$$FMADD^XLFDT(BDT,-365)
  1.  S EXDT=$$FMADD^XLFDT(BDT,-(365*3))
  1.  F  S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"")  S IFN=0 F  S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"")  D:$D(^PSRX(IFN,0))
  1.  .Q:$P($G(^PSRX(IFN,"STA")),"^")=13  ;deleted
  1.  .Q:'$P(^PSRX(IFN,0),U,6)   ; Prescription must have a drug
  1.  .S ID=$P(^PSRX(IFN,0),U,13)  ;issue date
  1.  .Q:ID<D365
  1.  .Q:ID>EDT
  1.  .S DC=$P($G(^PSRX(IFN,3)),U,5)  ;dc date
  1.  .I DC]"" Q:DC<BDT  ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD
  1.  .S G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$P(^PSRX(IFN,0),U,1) Q
  1.  I G]"" Q G
  1.  ;now check NVA meds
  1. NVA ; Set Non-VA Med Orders in the ^TMP Global
  1.  S G=""
  1.  F I=0:0 S I=$O(^PS(55,P,"NVA",I)) Q:'I!(G]"")  S X=$G(^PS(55,P,"NVA",I,0)) D
  1.  .Q:'$P(X,"^")
  1.  .S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))
  1.  .I $P(X,"^",7),$P(X,"^",7)<BDT Q  ;DC'ED
  1.  .S SDT=$P(X,"^",10) I 'SDT Q  ;NO documented date
  1.  .I SDT>EDT Q  ;documented date after end date
  1.  .Q:$P(X,U,6)]""
  1.  .S G=1_U_"NVA: "_$$DATE^APCM1UTL($P(X,U,10))_" Item: "_DRG
  1.  I G]"" Q G
  1.  Q G
  1.  ; Return boolean flag indicating valid patient
  1. PATVRY(RX,PAT) ;EP
  1.  Q:PAT="*" 1
  1.  Q +$P($G(^PSRX(RX,0)),U,2)=PAT
  1.  ; Return release date for dispense
  1. DSPRDT(RX,TYP,SIEN) ;EP
  1.  Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))