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

AMHAPRB.m

Go to the documentation of this file. 
  1. AMHAPRB ; IHS/CMI/LAB - PROMPT FOR PROBLEM ;
  1.  ;;4.0;IHS BEHAVIORAL HEALTH;**2,4**;JUN 18, 2010;Build 28
  1.  ;
  1. PLUDE(AMHPRBI,AMHP,AMHV,AMHD,AMHTPRD) ;EP - called from data entry input templates
  1.  ;
  1.  D EN^XBNEW("PLUDE1^AMHAPRB","AMHP;AMHV;AMHD;AMHPRBI;AMHTPRD")
  1.  Q
  1. PLUDE1 ;EP - called from xbnew
  1.  ;get date pl updated
  1.  I $G(AMHD)="" S AMHD=$P(^AMHREC(AMHV,0),U,1)
  1.  S DIR(0)="D^::EPTSX",DIR("A")="Enter the Date the Problem List was Updated by the Provider"
  1.  S DIR("B")=$$FMTE^XLFDT(DT),DIR("?")="This is the visit date or the date the provider updated the problem list."
  1.  KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"This is required." G PLUDE1
  1.  I $P(Y,".")>DT W !!,"Future Dates now allowed.",! G PLUDE1
  1.  S AMHD=Y
  1. PLUDE1P ;GET PROVIDER
  1.  S DIR(0)="9002011.14,1204",DIR("A")="Enter the individual that updated the Problem List"
  1.  S DIR("A",1)="Enter the individual that updated the Problem List. If you are"
  1.  S DIR("A",2)="transcribing an update from a BHS provider, then enter the name"
  1.  S DIR("A",3)="of the provider.  If you are a data entry/coder correcting the"
  1.  S DIR("A",4)="Problem List (for instance, correcting the diagnosis code) then enter your"
  1.  S DIR("A",5)="own name."
  1.  S DIR("B")=$S($G(AMHV):$$PRIMPROV^AMHUTIL(AMHV,"N"),1:"") KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) W !!,"This is required."  G PLUDE1P
  1.  S AMHPRV=+Y
  1.  D PLU($G(AMHPRBI),AMHV,AMHP,AMHD,AMHPRV,.AMHRET)
  1.  I $P(AMHRET,U,1)=0 W !!,"error:  ",$P(AMHRET,U,2)
  1.  Q
  1. PLU(AMHPIEN,AMHV,AMHP,AMHD,AMHPRV,RETVAL) ;PEP - called to update Problem list 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:  AMHPIEN - ien of problem list entry
  1.  ;        AMHV - ien of RECORD, if in the context of a visit
  1.  ;        AMHP - DFN
  1.  ;        AMHD - Date and optionally time of problem list update (fileman format)
  1.  ;        AMHPRV = ien of provider updating the problem list
  1.  ;this API will create a new V UPDATED/REVIEWED entry if there isn't currently one
  1.  ;for Provider AMHP on date AMHD
  1.  ;if not in the context of a visit (AMHV = 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 AMHPIEN=$G(AMHPIEN)
  1.  S AMHV=$G(AMHV)
  1.  S AMHP=$G(AMHP)
  1.  I 'AMHP S RETVAL="0^not a valid patient DFN" Q
  1.  I '$D(^AUPNPAT(AMHP,0)) S RETVAL="0^not a valid patient DFN" Q
  1.  S AMHD=$G(AMHD)
  1.  I 'AMHD S RETVAL="0^no valid date passed" Q
  1.  S AMHPRV=$G(AMHPRV)
  1.  I 'AMHPRV S RETVAL="0^no valid provider ien passed" Q
  1.  S RETVAL=""
  1.  ;
  1.  I AMHV D PLUV Q
  1.  Q
  1. PLUV ;have a visit so create a v updated/reviewed for provider AMHPRV if one does
  1.  ;not exist on this visit already.
  1.  NEW AMHX,AMHVD,AMHVRI,AMHVAL
  1.  S AMHVAL=$O(^AUTTCRA("C","PLU",0))
  1.  I AMHVAL="" S RETVAL="0^action item missing" Q
  1.  S AMHVRI=""
  1.  S AMHX=0 F  S AMHX=$O(^AMHRRUP("AD",AMHV,AMHX)) Q:AMHX=""!(AMHVRI)  D
  1.  .;is this entry a problem list review entry?
  1.  .Q:$P(^AMHRRUP(AMHX,0),U,1)'=AMHVAL  ;this one isn't a PLU entry
  1.  .Q:$P($G(^AMHRRUP(AMHX,2)),U,1)
  1.  .Q:$P($G(^AMHRRUP(AMHX,12)),U,4)'=AMHPRV  ;not this provider
  1.  .S AMHVRI=AMHX  ;found one so don't create one
  1.  .Q
  1.  I AMHVRI S RETVAL=AMHVRI Q
  1.  ;create MHSS UPDATED/REVIEWED entry
  1.  S DIC="^AMHRRUP(",X=AMHVAL,DIC("DR")=".02////"_AMHP_";.03////"_AMHV_";1201////"_AMHD_";1204////"_AMHPRV,DIADD=1,DLAYGO=9002011.14,DIC(0)="EL"
  1.  D FILE^DICN
  1.  K DLAYGO,DIADD,DIC,DA
  1.  Q
  1. ANYACTP(P,EDATE) ;EP - does this patient have any active problems?
  1.  I '$G(P) Q 0
  1.  S EDATE=$G(EDATE)
  1.  NEW X,Y,Z
  1.  S Z=0
  1.  S X=0 F  S X=$O(^AMHPPROB("AC",P,X)) Q:X'=+X!(Z)  D
  1.  .Q:'$D(^AMHPPROB(X,0))
  1.  .Q:$P(^AMHPPROB(X,0),U,12)'="A"
  1.  .I EDATE,$P(^AMHPPROB(X,0),U,8)>EDATE Q
  1.  .S Z=1
  1.  .Q
  1.  Q Z
  1. PLUPCC(AMHREC,AMHPIEN,AMHP) ;EP
  1.  I '$G(AMHREC) Q
  1.  I '$D(^AMHREC(AMHREC,0)) Q
  1.  NEW AMHV,DIE,DA,DR
  1.  S AMHV=$P(^AMHREC(AMHREC,0),U,16)
  1.  ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
  1.  S DA=AMHREC,DIE="^AMHREC(",DR="1801///"_$P(^AMHREC(AMHREC,0),U,1)_";1802////"_AMHP D ^DIE K DIE,DA,DR
  1.  I 'AMHV Q  ;No pcc visit yet, it will get updated later
  1.  ;create V updated/reviewed and attach it to the pcc visit.  call pcc routines
  1.  NEW AMHVAL S AMHVAL=""
  1.  D PLU^APCDAPRB($G(AMHPIEN),AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHP:AMHP,1:DUZ),.AMHVAL)
  1.  Q
  1.  ;
  1. PLRPCC(AMHREC,AMHD,AMHPROV) ;EP
  1.  I '$G(AMHREC) Q
  1.  I '$D(^AMHREC(AMHREC,0)) Q
  1.  NEW AMHV,DIE,DA,DR
  1.  S AMHV=$P(^AMHREC(AMHREC,0),U,16)
  1.  ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
  1.  S DA=AMHREC,DIE="^AMHREC(",DR="1803///"_$P(^AMHREC(AMHREC,0),U,1)_";1804////"_AMHPROV D ^DIE K DIE,DA,DR
  1.  I 'AMHV Q  ;No pcc visit yet, it will get updated later
  1.  ;create V updated/reviewed and attach it to the pcc visit.  call pcc routines
  1.  NEW AMHVAL S AMHVAL=""
  1.  D PLRADD^APCDPL1(AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
  1.  Q
  1.  ;
  1. NAPPCC(AMHREC,AMHD,AMHPROV) ;EP
  1.  I '$G(AMHREC) Q
  1.  I '$D(^AMHREC(AMHREC,0)) Q
  1.  NEW AMHV,DIE,DA,DR
  1.  S AMHV=$P(^AMHREC(AMHREC,0),U,16)
  1.  ;set field to let link know to create PCC V Updated/Reviewed entry that PCC PL was updated by BH provider
  1.  S DA=AMHREC,DIE="^AMHREC(",DR="1805///"_$P(^AMHREC(AMHREC,0),U,1)_";1806////"_AMHPROV D ^DIE K DIE,DA,DR
  1.  I 'AMHV Q  ;No pcc visit yet, it will get updated later
  1.  ;create V updated/reviewed and attach it to the pcc visit.  call pcc routines
  1.  NEW AMHVAL S AMHVAL=""
  1.  D NAPADD^APCDPL1(AMHV,$P(^AMHREC(AMHREC,0),U,8),$P(^AMHREC(AMHREC,0),U,1),$S(AMHPROV:AMHPROV,1:DUZ),.AMHVAL)
  1.  Q