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

HMPACT.m

Go to the documentation of this file. 
  1. HMPACT ;ASMR/EJK/PB/JD - Patient Appointment Broker Call;May 15, 2016 14:15
  1.  ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**1**;May 15, 2016;Build 4
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; 2/16/16 - JD - Removed the check in line tag ADMIT to allow processing of all patients
  1.  ;                regardless of their subscription. DE3375
  1.  ;
  1.  ; Feb 24, 2016 - PB removed the check in linetag SCHED that quit
  1.  ; processing if the patient was registered in HMP(800000 as requested in DE2991
  1.  Q
  1. ACT(ROOT,DFN,ID,ALPHA,OMEGA,DTRANGE,REMOTE,MAX,ORFHIE) ;
  1.  N ERR,ERRMSG,DFN,IEN,DIE,HMSTOP
  1.  S ERR=0,ERRMSG="",DFN="",IEN="",HMSTOP=0
  1.  S ROOT="XWBY"
  1.  K ^TMP("ORDATA",$J)
  1.  Q:'$D(^HMP(800001.5,"PTAPPT","HMP"))
  1.  S DIE="^HMP(800001.5,""PTAPPT"","
  1.  D FETCH
  1.  D CLEAN
  1.  Q
  1.  ;
  1. FETCH ;GET PENDING JSON MESSAGES AND UPDATE DATE RECORD RETRIEVED
  1.  S X="[" D SETITEM(.ROOT,X)
  1.  F  S IEN=$O(^HMP(800001.5,"PTAPPT","HMP",IEN)) Q:IEN=""!(HMSTOP)  D
  1.  . S X=$G(^HMP(800001.5,"PTAPPT",IEN,"JSON"))
  1.  . I $O(^HMP(800001.5,"PTAPPT","HMP",IEN))="" S $E(X,$L(X))="",HMSTOP=1
  1.  . D SETITEM(.ROOT,X)
  1.  . S DA=IEN,DR="6///1" D ^DIE
  1.  . Q
  1.  S X="]" D SETITEM(.ROOT,X)
  1.  Q
  1.  ;
  1. CLEAN ;CLEAN UP STRAY VARIABLES
  1.  K DA,DR,X
  1.  Q
  1.  ;
  1. SETITEM(ROOT,X) ; -- set item in list - RRB US5872 
  1.  S @ROOT@($O(@ROOT@(9999),-1)+1)=X
  1.  Q
  1.  ;
  1. APPT(HMPOUT,BEG,END,LOCIEN) ; Lookup appointments by date and location
  1.  ;
  1.  ;Associated ICRs:
  1.  ;  ICR#
  1.  ;      2051:  Database Server API: Lookup Utilities
  1.  ;             FIND1^DIC
  1.  ;      10103: XLFDT Date functions
  1.  ;             HTFM^XLFDT
  1.  ;  SUPPORTED: VADPT
  1.  ;             SDA^VADPT
  1.  ;             KVA^VADPT
  1.  ;             KVAR^VADPT
  1.  ;             SDAPI^SDAMA301
  1.  ;
  1.  ; BEG - FileMan date for starting the search - If not defined, defaults to current date
  1.  ; END - FileMan date to end the search - if not defined, defaults to the current date
  1.  ; LOCIEN - The IEN for the clinic entry in the Hospital Location file (#44) If not defined, it will get a list of clinics and return the appointments for all clinics for the date range
  1.  ; Returns data in the TMP($J,"HMPAPPT" global. Returns : DFN ^ APPOINTMENT DATE/TIME ^ CLINIC NAME ^ CLINIC IEN 
  1.  ;
  1.  N DFN,LOC,OVER,PAT,REQ,SD,SCX
  1.  I '$G(BEG) S BEG=$$HTFM^XLFDT(+$H)  ; Default current day
  1.  S BEG=$P(BEG,".",1)
  1.  I BEG'?7N Q -1
  1.  I '$G(END) S END=$$HTFM^XLFDT(+$H)  ; Default current day
  1.  S END=$P(END,".",1)
  1.  I END'?7N Q -1
  1.  I END<BEG Q -1
  1.  K ^TMP($J,"HMPAPPT")
  1.  S HMPOUT=$NA(^TMP($J,"HMPAPPT"))
  1.  I $G(LOCIEN) D SCHED(LOCIEN,BEG,END) G ENDAPPT
  1.  K LOC
  1.  ;DE2818, changed location check routine to HMPXGSD
  1.  D CLINLOC^HMPXGSD(.LOC,"",1)  ; Lookup VistA Clinic Locations
  1.  ;
  1.  ; The clinic locations will be returned in the HMPOUT array:
  1.  ;     LOC(D1)=LOCIEN^LOCNAME
  1.  ;
  1. LOCLKUP ; Gets all appointments for all clinics in the LOC(D1) array
  1.  N LOCNAME
  1.  S SCX=""
  1.  F  S SCX=$O(LOC(SCX)) Q:SCX=""  D
  1.  . S LOCIEN=$P(LOC(SCX),U,1),LOCNAME=$P(LOC(SCX),U,2)
  1.  . D SCHED(LOCIEN,BEG,END)
  1.  G ENDAPPT
  1.  ;
  1. SCHED(LOCIEN,BEG,END) ;
  1.  ; Get list of patients and appointment dates from the
  1.  ; using $$SDAPI^SDAMA301 api.
  1.  ; Inputs are SDARRAY(1)=BEG;END - Beginning and ending dates for the search. 
  1.  ; BEG must be defined.
  1.  ; END ending date for the search. If END is undefined, the API returns all appointments starting with the BEG date.
  1.  ; BEG and END are FileMan Date/Time. Both BEG and END are validated in the calling linetag APPT^HMPACT
  1.  ; LOCIEN = IEN for the location in the Hospital Location file (#44). LOCIEN is validated in the calling linetag APPT^HMPACT
  1.  ; 
  1.  ; Feb 24, 2016 - PB - DE2991 requested that all patients be returned. Prior to DE2991, if a patient was in the HMP Subscription file (#800000)
  1.  ; they were excluded from the return data.
  1.  K ^TMP($J,"SDAMA301") ; Kill the TMP global that stores the results from SDAPI^SDAMA301
  1.  K SDARRAY,SDCNT ; kill the SDARRAY that stores the input variables for the SDAPI^SDAMA301 call, SDCNT returns the number of appointments found. If SDCNT > 0 data is returned in the ^TMP($J,"SDAMA301" temp global
  1.  S SDARRAY(1)=BEG_";"_END,SDARRAY(2)=LOCIEN,SDARRAY("FLDS")="1;2;4"  ;input variables for $$SDAPI^SDAMA301
  1.  S SDCNT=$$SDAPI^SDAMA301(.SDARRAY) I $G(SDCNT)>0 D
  1.  . K XDFN S XDFN=0
  1.  . F  S XDFN=$O(^TMP($J,"SDAMA301",LOCIEN,XDFN)) Q:XDFN=""  S APTDATE=0 F  S APTDATE=$O(^TMP($J,"SDAMA301",LOCIEN,XDFN,APTDATE)) Q:APTDATE=""  D
  1.  . . K LOCALE S LOCALE=$P(^TMP($J,"SDAMA301",LOCIEN,XDFN,APTDATE),"^",2),LOCNAME=$P(LOCALE,";",2)
  1.  . . S ^TMP($J,"HMPAPPT",XDFN,APTDATE,LOCIEN)=XDFN_U_APTDATE_U_LOCNAME_U_LOCIEN  ;^TMP("HMPAPPT" is killed in APPT^HMPACT before calling this linetag (SCHED)
  1.  K SDFN,APTDATE,LOCNAME,SDCNT,SDARRAY,^TMP($J,"SDAMA301")  ; clean up variables
  1.  Q
  1.  ;
  1. ENDAPPT ;
  1.  ;
  1.  M @HMPOUT=^TMP($J,"HMPAPPT")
  1.  K @HMPOUT@(0)
  1.  Q
  1.  ;
  1. ADMIT(HMPOUT,LOCIEN) ; Lookup admissions by location
  1.  ;
  1.  ;Associated ICRs:
  1.  ;  ICR#
  1.  ;      2051:  Database Server API: Lookup Utilities
  1.  ;             FIND1^DIC
  1.  ;             LIST^DIC
  1.  ;      10103: XLFDT Date functions
  1.  ;             HTFM^XLFDT
  1.  ;  SUPPORTED: VADPT
  1.  ;             INP^VADPT
  1.  ;             KVA^VADPT
  1.  ;             KVAR^VADPT
  1.  ;
  1.  N DFROM,DIEN,DOUT,DPART,DRID,FILE,FLDS,FLG,MAX,PIDX,SCRN,SUBSCRP,WARD,XREF
  1.  K ^TMP("HMPADMIT",$J)
  1.  S HMPOUT=$NA(^TMP("HMPADMIT",$J))
  1.  ; Get Patient list by Ward
  1.  S FILE=2,DIEN="",FLDS="@;.1",FLG="P",MAX="",DFROM="",DPART="",XREF="ACN"
  1.  S SCRN="I $P($G(^DPT(+Y,.102)),""^"")>0",DRID="",DOUT=""
  1.  ; The SCRN parameter is set to insure the patient record has a current movement file entry.
  1.  K ^TMP("DILIST",$J)
  1.  D LIST^DIC(FILE,DIEN,FLDS,FLG,MAX,.DFROM,DPART,XREF,SCRN,DRID,DOUT)  ; ICR #2051
  1.  ; The list of patients and associated wards are returned via the ^TMP("DILIST",$J,PIDX,0) global in the following format:
  1.  ;      ^TMP("DILIST",$J,PIDX,0)=DFN^WARD
  1.  ;      Note:  The WARD is the ward name, not an internal (IEN) entry
  1.  S PIDX=0
  1.  F  S PIDX=$O(^TMP("DILIST",$J,PIDX)) Q:PIDX=""  D
  1.  . S DFN=$P(^TMP("DILIST",$J,PIDX,0),U,1),WARD=$P(^TMP("DILIST",$J,PIDX,0),U,2)
  1.  . ; If the calling application passes a ward LOCIEN, Use the WARD LOCATION File (#42) to lookup
  1.  . ; the ward (location) IEN for comparison to the requested LOCIEN to screen out any entries that don't match the request.
  1.  . ; 
  1.  . I LOCIEN'="",LOCIEN'=$$FIND1^DIC(42,"","BX",WARD,"B","","") Q
  1.  . ; Check patients for HMP subscription, File (#800000) and setup patient data
  1.  . ; Removed the subscription check.  JD - 2/16/16. DE3375
  1.  . D GETADMIT(DFN)
  1.  ;
  1. ENDADMIT ;
  1.  ;
  1.  M @HMPOUT=^TMP("HMPADMIT",$J)
  1.  K @HMPOUT@(0)
  1.  Q
  1.  ;
  1. GETADMIT(DFN) ;
  1.  N ADMIT,PDATA,LOC,LOCNAME,LRMBD,VAERR,VAIN
  1.  ; Lookup patient admissions data
  1.  ; Use supported INP^VADPT call to get the admissions data from the Patient File (#2)
  1.  D INP^VADPT
  1.  ; LOC = Ward (Location) IEN, LOCNAME = Ward (Location) Name, LRMBD = Room-Bed Name (Optional depending upon inpatient
  1.  ; location setup), ADMIT = Admission date.time in VA format
  1.  S LOC=$P(VAIN(4),U),LOCNAME=$P(VAIN(4),U,2),LRMBD=VAIN(5),ADMIT=$P(VAIN(7),U)
  1.  K PDATA
  1.  S PDATA=DFN_U_ADMIT_U_LOCNAME_U_LRMBD_U_LOC
  1.  S ^TMP("HMPADMIT",$J,DFN,LOC)=PDATA
  1.  ; Supported calls to Kill VADPT variables
  1.  D KVAR^VADPT,KVA^VADPT
  1.  ;
  1.  Q
  1.  ;