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

APCDAMED.m

Go to the documentation of this file. 
  1. APCDAMED ; IHS/CMI/LAB - PROMPT FOR medication ; 12 Oct 2010  6:46 AM
  1.  ;;2.0;IHS PCC SUITE;**5**;MAY 14, 2009
  1.  ;
  1. MLUDE ;EP - called from data entry input templates
  1.  ;get provider who updated and date
  1.  ;NEW APCDPRBI
  1.  ;S APCDPRBI=DA
  1.  S APCDP=$G(APCDPAT)
  1.  I 'APCDP S APCDP=$G(DFN)
  1.  S APCDV=$G(APCDVSIT)
  1.  S APCDD=$G(APCDDATE)
  1.  ;
  1.  D EN^XBNEW("MLUDE1^APCDAMED","APCDP;APCDV;APCDD;APCDPRBI")
  1.  Q
  1. MLUDE1 ;EP - called from xbnew
  1.  ;get date pl updated
  1.  S DIR(0)="D^::EPTSX",DIR("A")="Enter the Date the Medication List was Updated by the Provider"
  1.  S DIR("B")=$S($G(APCDD):$$FMTE^XLFDT($P(APCDD,".")),$G(APCDV):$$FMTE^XLFDT($$VD^APCLV(APCDV)),1:$$FMTE^XLFDT(DT)),DIR("?")="This is the visit date or the date the provider updated the medication list.  Enter the Time, if known."
  1.  KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"This is required." G MLUDE1
  1.  I $P(Y,".")>DT W !!,"Future Dates now allowed.",! G MLUDE1
  1.  S APCDD=Y
  1. MLUDE1P ;GET PROVIDER
  1.  S DIR(0)="9000010.54,1204",DIR("A")="Enter the PROVIDER who Updated the Medication List"
  1.  S DIR("B")=$S($G(APCDV):$$PRIMPROV^APCLV(APCDV,"N"),1:"") KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"This is required."  G MLUDE1P
  1.  S APCDPRV=+Y
  1.  D MLU($G(APCDPRBI),APCDV,APCDP,APCDD,APCDPRV,.APCDRET)
  1.  I $P(APCDRET,U,1)=0 W !!,"error:  ",$P(APCDRET,U,2)
  1.  Q
  1. MLU(APCDPIEN,APCDV,APCDP,APCDD,APCDPRV,RETVAL) ;PEP - called to update MEDICATION update fields
  1.  ;this API can be called to have a V UPDATED/REVIEWED entry and populate the
  1.  ;.11, .12, and .13 fields
  1.  ;input:  APCDPIEN - ien of medication entry
  1.  ;        APCDV - ien of visit, if in the context of a visit
  1.  ;        APCDP - DFN
  1.  ;        APCDD - Date and optionally time of medication list update (fileman format)
  1.  ;        APCDPRV = ien of provider updating the medication list
  1.  ;this API will create a new V UPDATED/REVIEWED entry if there isn't currently one
  1.  ;for Provider APCDP on date APCDD
  1.  ;if not in the context of a visit (APCDV = null) then an event visit will be created
  1.  ;with a V UPDATED/REVIEWED v file entry
  1.  ;
  1.  ;RETURN VALUE:
  1.  ;            ien of V UPDATED/REVIEWED entry that was created
  1.  ;             or 0^error message
  1.  S APCDPIEN=$G(APCDPIEN)
  1.  S APCDV=$G(APCDV)
  1.  S APCDP=$G(APCDP)
  1.  I 'APCDP S RETVAL="0^not a valid patient DFN" Q
  1.  I '$D(^AUPNPAT(APCDP,0)) S RETVAL="0^not a valid patient DFN" Q
  1.  S APCDD=$G(APCDD)
  1.  I 'APCDD S RETVAL="0^no valid date passed" Q
  1.  S APCDPRV=$G(APCDPRV)
  1.  I 'APCDPRV S RETVAL="0^no valid provider ien passed" Q
  1.  S RETVAL=""
  1.  ;
  1.  I APCDV D MLUV Q
  1.  ;NO VISIT SO CREATE EVENT VISIT AND CALL MLUV
  1.  D EVSIT
  1.  Q
  1. MLUV ;have a visit so create a v updated/reviewed for provider APCDPRV if one does
  1.  ;not exist on this visit already.
  1.  NEW APCDX,APCDVD,APCDVRI,APCDVAL
  1.  S APCDVAL=$O(^AUTTCRA("C","MLU",0))
  1.  I APCDVAL="" S RETVAL="0^action item missing" Q
  1.  S APCDVRI=""
  1.  S APCDX=0 F  S APCDX=$O(^AUPNVRUP("AD",APCDV,APCDX)) Q:APCDX=""!(APCDVRI)  D
  1.  .;is this entry a medication list review entry?
  1.  .Q:$P(^AUPNVRUP(APCDX,0),U,1)'=APCDVAL  ;this one isn't a MLU entry
  1.  .Q:$P($G(^AUPNVRUP(APCDX,2)),U,1)
  1.  .Q:$P($G(^AUPNVRUP(APCDX,12)),U,4)'=APCDPRV  ;not this provider
  1.  .S APCDVRI=APCDX  ;found one so don't create one
  1.  .Q
  1.  I APCDVRI S RETVAL=APCDVRI Q
  1.  ;create V UPDATED/REVIEWED entry
  1.  NEW APCDALVR
  1.  S APCDALVR("APCDPAT")=APCDP
  1.  S APCDALVR("APCDVSIT")=APCDV
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.54 (ADD)]"
  1.  S APCDALVR("APCDTCLA")="`"_APCDVAL
  1.  S APCDALVR("APCDTCDT")=APCDD
  1.  S APCDALVR("APCDTEPR")="`"_APCDPRV
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S RETVAL=0_"^Error creating V UPDATED/REVIEWED entry.  PCC not updated."
  1.  K APCDALVR
  1.  Q
  1. BSD ;
  1.  NEW APCDBSDV
  1.  K APCDIN
  1.  S APCDIN("PAT")=APCDP
  1.  S APCDIN("VISIT DATE")=APCDD_".12"
  1.  S APCDIN("SITE")=DUZ(2)
  1.  S APCDIN("VISIT TYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
  1.  S APCDIN("SRV CAT")="E"
  1.  S APCDIN("TIME RANGE")=0
  1.  S APCDIN("USR")=DUZ
  1.  K APCDALVR
  1.  K APCDBSDV
  1.  D GETVISIT^APCDAPI4(.APCDIN,.APCDBSDV)
  1.  S T=$P(APCDBSDV(0),U,2)
  1.  I T]"" S RETVAL="0^could not create event visit" Q   ;errored
  1.  S V=$O(APCDBSDV(0)) S APCDV=V
  1.  I $G(APCDBSDV(V))="ADD" D DEDT^APCDEA2(APCDV)
  1.  Q
  1. EVSIT ;EP - get/create event visit
  1.  I $L($T(^BSDAPI4)) D  Q
  1.  .D BSD
  1.  .D MLUV
  1.  K APCDVSIT
  1.  K APCDALVR
  1.  S APCDALVR("APCDAUTO")=""
  1.  S APCDALVR("APCDPAT")=APCDP
  1.  S APCDALVR("APCDCAT")="E"
  1.  S APCDALVR("APCDLOC")=DUZ(2)
  1.  S APCDALVR("APCDTYPE")=$S($P($G(^APCCCTRL(DUZ(2),0)),U,4)]"":$P(^APCCCTRL(DUZ(2),0),U,4),1:"O")
  1.  S APCDALVR("APCDDATE")=APCDD_".12"
  1.  D ^APCDALV
  1.  S APCDV=$G(APCDALVR("APCDVSIT"))
  1.  I $G(APCDALVR("APCDVSIT","NEW")) D DEDT^APCDEA2(APCDVSIT)
  1.  K APCDALVR
  1.  D MLUV
  1.  Q
  1. ANYACTM(APCDSDFN,EDATE) ;EP - medications component
  1.  ;get all meds in the past year +30 days
  1.  NEW APCDMEDS,APCDMED,X,M,I,N,D,APCDKEEP,APCDM,APCDRXN,APCDRXO,APCDRX0,APCDSREF,APCDSTAT,C,APCDN,APCDI,APCDD,APCDC
  1.  NEW X,M,D,N,C,Z,P,I,EXPDT,Y
  1.  ;
  1.  ;store each drug by inverse date
  1.  I '$G(EDATE) S EDATE=DT
  1.  K APCDMED,APCDALL
  1.  ;GET ALL PRESCRIPTIONS IN PHARMACY PATIENT FILE FOR -395 TO TODAY BY EXPIRATION DATE IN PS(55
  1.  S EXPDT=$$FMADD^XLFDT(EDATE,-395)
  1.  F  S EXPDT=$O(^PS(55,APCDSDFN,"P","A",EXPDT)) Q:EXPDT'=+EXPDT  D
  1.  .S I=0 F  S I=$O(^PS(55,APCDSDFN,"P","A",EXPDT,I)) Q:I'=+I  D
  1.  ..Q:'$D(^PSRX(I,0))
  1.  ..S D=$P(^PSRX(I,0),U,6)
  1.  ..I '$D(^PSDRUG(D,0)) Q  ;no drug
  1.  ..S N=$P(^PSDRUG(D,0),U)
  1.  ..S P=$P(^PSRX(I,0),U,2)
  1.  ..I P'=APCDSDFN Q  ;oops, bad data
  1.  ..S L=$P($G(^PSRX(I,3)),U,1)  ;last dispensed date
  1.  ..I L="" S L=$O(^PSRX(I,1,"B",9999999),-1)
  1.  ..I L="" S L=$P($G(^PSRX(I,2)),U,2)
  1.  ..I L="" S L=$P(^PSRX(I,0),U,13)
  1.  ..Q:L=""
  1.  ..S L=9999999-L
  1.  ..S S=$P($G(^PSRX(I,"STA")),U,1)
  1.  ..Q:S=1
  1.  ..Q:S=4
  1.  ..Q:S=10
  1.  ..Q:S=12
  1.  ..Q:S=13
  1.  ..Q:S=14
  1.  ..Q:S=15
  1.  ..Q:S=16
  1.  ..S APCDALL(N,D,L,I)=S
  1.  ;now kill off all except the latest one
  1.  K APCDKEEP
  1.  S N="" F  S N=$O(APCDALL(N)) Q:N=""  D
  1.  .S D=0 F  S D=$O(APCDALL(N,D)) Q:D=""  D
  1.  ..Q:$D(APCDKEEP(N,D))
  1.  ..S L=$O(APCDALL(N,D,0))
  1.  ..S I=$O(APCDALL(N,D,L,0))
  1.  ..S APCDKEEP(N,D,L,I)=APCDALL(N,D,L,I)
  1.  ;now go through and group them
  1.  S N="" F  S N=$O(APCDKEEP(N)) Q:N=""  D
  1.  .S D=0 F  S D=$O(APCDKEEP(N,D)) Q:D=""  D
  1.  ..S L=0 F  S L=$O(APCDKEEP(N,D,L)) Q:L=""  D
  1.  ...S I=0 F  S I=$O(APCDKEEP(N,D,L,I)) Q:I'=+I  D
  1.  ....S S=APCDKEEP(N,D,L,I)
  1.  ....I S=11 D GRP2 Q
  1.  ....D GRP1
  1.  ;NOW GET OUTSIDE MEDS DEFINED AS ANY WITH 1108 FIELD OR EVENT VISIT SERVICE CATEGORY
  1.  K APCDMEDS,APCDM
  1.  D GETMEDS^APCHSMU1(APCDSDFN,$$FMADD^XLFDT(DT,-365),DT,,,,,.APCDMEDS)
  1.  ;store each drug by inverse date
  1.  S X=0 F  S X=$O(APCDMEDS(X)) Q:X'=+X  D
  1.  .S M=$P(APCDMEDS(X),U,4)
  1.  .S V=$P(^AUPNVMED(M,0),U,3)
  1.  .I $P(^AUPNVSIT(V,0),U,7)'="E",$P($G(^AUPNVMED(M,11)),U,8)="" Q
  1.  .Q:$P(^AUPNVMED(M,0),U,8)  ;discontinued
  1.  .S D=$P(^AUPNVMED(M,0),U,1)
  1.  .S N=$S($P(^AUPNVMED(M,0),U,4)]"":$P(^AUPNVMED(M,0),U,4),1:$P(^PSDRUG(D,0),U,1))
  1.  .S APCDM(N,D,(9999999-$P(APCDMEDS(X),U,1)))=APCDMEDS(X)
  1.  ;now get rid of all except the latest one
  1.  K APCDKEEP
  1.  S N="" F  S N=$O(APCDM(N)) Q:N=""  D
  1.  .S D=0 F  S D=$O(APCDM(N,D)) Q:D=""  D
  1.  ..Q:$D(APCDMED(N,D))
  1.  ..S X=$O(APCDM(N,D,0))
  1.  ..S M=$P(APCDM(N,D,X),U,4)
  1.  ..S APCDMED(1,N,D,X)=M_U_"M"
  1.  I $O(APCDMED(0)) Q 1
  1.  K APCDMED
  1.  ;now get all NVA meds that did not move to PCC V MED
  1.  S X=0 F  S X=$O(^PS(55,APCDSDFN,"NVA",X)) Q:X'=+X  D
  1.  .I $P($G(^PS(55,APCDSDFN,"NVA",X,999999911)),U,1),$D(^AUPNVMED($P(^PS(55,APCDSDFN,"NVA",X,999999911),U,1),0)) Q  ;got this with V MED
  1.  .S L=$P($P($G(^PS(55,APCDSDFN,"NVA",X,0)),U,10),".")
  1.  .S L=9999999-L
  1.  .I L<$$FMADD^XLFDT(DT,-365) Q
  1.  .Q:$P(^PS(55,APCDSDFN,"NVA",X,0),U,6)=1  ;discontinued
  1.  .I $P(^PS(55,APCDSDFN,"NVA",X,0),U,7)]""  ;discontinued date
  1.  .S APCDMED(1)=""
  1.  I $O(APCDMED(0)) Q 1
  1.  ;NOW CHECK TO SEE IF THERE ARE ANY MEDS IN V MED IN THE PAST 30 DAYS
  1.  K APCDMEDS
  1.  D GETMEDS^APCHSMU1(APCDSDFN,$$FMADD^XLFDT(DT,-31),DT,,,,,.APCDMEDS)
  1.  I $O(APCDMEDS(0)) Q 2
  1.  Q 0
  1. GRP2 ;
  1.  Q:'$D(^PS(55,APCDSDFN,"P","CP",I))  ;CHRONIC ONLY
  1.  S C=$S(I:$D(^PS(55,APCDSDFN,"P","CP",I)),1:0)
  1.  S Y=$S(C:120,1:14)
  1.  Q:$$FMDIFF^XLFDT(DT,$P($G(^PSRX(I,2)),U,6))>Y
  1.  S APCDMED(2,N,D,L)=I_U_"P"
  1.  Q
  1. GRP1 ;
  1.  S APCDMED(1,N,D,L)=I_U_"P"
  1.  Q
  1. MLR(APCDTDA) ;EP - called from nap template to create PLR entry
  1.  D EN^XBNEW("MLR1^APCDAMED","APCDTDA")
  1.  Q
  1. MLR1 ;
  1.  ;create MLR entry on this visit
  1.  ;create V UPDATED/REVIEWED entry
  1.  NEW APCDALVR,APCDVAL
  1.  S APCDVAL=$O(^AUTTCRA("C","MLR",0))
  1.  S APCDALVR("APCDPAT")=$P(^AUPNVRUP(APCDTDA,0),U,2)
  1.  S APCDALVR("APCDVSIT")=$P(^AUPNVRUP(APCDTDA,0),U,3)
  1.  S APCDALVR("APCDATMP")="[APCDALVR 9000010.54 (ADD)]"
  1.  S APCDALVR("APCDTCLA")="`"_APCDVAL
  1.  S APCDALVR("APCDTCDT")=$P($G(^AUPNVRUP(APCDTDA,12)),U,1)
  1.  I $P($G(^AUPNVRUP(APCDTDA,12)),U,4) S APCDALVR("APCDTEPR")="`"_$P(^AUPNVRUP(APCDTDA,12),U,4)
  1.  D ^APCDALVR
  1.  I $D(APCDALVR("APCDAFLG")) S RETVAL=0_"^Error creating V UPDATED/REVIEWED entry.  PCC not updated."
  1.  K APCDALVR
  1.  Q