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

 
LOCIEN'="",LOCIEN'=$$FIND1^DIC(42,"","BX",WARD,"B","",""Q
 
; Check patients for HMP subscription, File (#800000) and setup patient data
 
; Removed the subscription check.  JD - 2/16/16. DE3375
 
GETADMIT(DFN)
 
;
ENDADMIT ;
 ;
 
@HMPOUT=^TMP("HMPADMIT",$J)
 
@HMPOUT@(0)
 
Q
 
;
GETADMIT(DFN) ;
 
ADMIT,PDATA,LOC,LOCNAME,LRMBD,VAERR,VAIN
 
; Lookup patient admissions data
 ; Use supported INP^VADPT call to get the admissions data from the Patient File (#2)
 
INP^VADPT
 
; LOC = Ward (Location) IEN, LOCNAME = Ward (Location) Name, LRMBD = Room-Bed Name (Optional depending upon inpatient
 ; location setup), ADMIT = Admission date.time in VA format
 
LOC=$P(VAIN(4),U),LOCNAME=$P(VAIN(4),U,2),LRMBD=VAIN(5),ADMIT=$P(VAIN(7),U)
 
PDATA
 
PDATA=DFN_U_ADMIT_U_LOCNAME_U_LRMBD_U_LOC
 
^TMP("HMPADMIT",$J,DFN,LOC)=PDATA
 
; Supported calls to Kill VADPT variables
 
KVAR^VADPT,KVA^VADPT
 
;
 
Q
 
;