HMPROS8 ;SLC/AGP,ASMR/RRB - Get CPRS User Default Roster List ; 6/11/14 8:38pm
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;AUG 17, 2011;Build 63
;Per VA Directive 6402, this routine should not be modified.
;
Q
;
BLDSORT(NODE,SRC,SORT,SEQ) ; emulate TStringList Sort found in CPRS
; append separator to ensure string sort (rather than numeric)
; append SEQ to avoid dropping node where SORTKEY is duplicated
; SORT: A:Alphabetic;R:Room/Bed;P:Appointment Date;T:Terminal Digit;S:Source
I $E(NODE)=U QUIT ; i.e., "^No patients found"
N SORTKEY,S
S NODE=$G(NODE),S=" "
S SORTKEY=$P(NODE,U,2)_S_SEQ ; default alphabetic by name
I SRC="C",(SORT="P") S SORTKEY=$P(NODE,U,4)_S_SEQ
I SRC="M" D
.I SORT="S" S SORTKEY=$P(NODE,U,3)_S_$P(NODE,U,8)_S_$P(NODE,U,2)_S_SEQ
.I SORT="P" S SORTKEY=$P(NODE,U,8)_S_$P(NODE,U,2)_S_SEQ
.I SORT="T" S SORTKEY=$P(NODE,U,5)_S_SEQ
I SRC="W",(SORT="R") S SORTKEY=$P(NODE,U,3)_S_$P(NODE,U,2)_S_SEQ
I '$L(SORTKEY) S SORTKEY=S_SEQ
S ^TMP("HMPSORT",$J,$P(SRC,U,2)_":"_SORT,SORTKEY)=NODE
Q
;
CHKPAT(PATIENTS,SERVER) ;
N ARGS,OUT,PAT,STATUS
S ARGS("command")="putPtSubscription"
S ARGS("server")=SERVER
S PAT="" F S PAT=$O(PATIENTS(PAT)) Q:PAT'>0 D
.S STATUS=$G(^HMP(800000,"AITEM",PAT,SERVER))
.I STATUS'="",STATUS>0 Q
.S ARGS("localId")=PAT
.D API^HMPDJFS(.OUT,.ARGS)
Q
;
GETDLIST(RESULT,SERVER) ;
N APPT,ARRAY,DFN,CNT,ERROR,GBL,GSOURCE,ISOUT,LISTIEN,LROOT,NAME,NODE,PATIENTS
N PATTYPE,PATUID,PID,ROOM,ROOT,SOURCE,SOURCETYPE,TYPE,TYPEI,HMPSRC,HMPSORT,HMPOUT
N XOBDATA S XOBDATA(0)=1
N XWBOS S XWBOS(0)=1
K ^TMP("OR",$J)
S HMPSRC=$$LSTSRC(DUZ)
S LISTIEN=$P(HMPSRC,U,2),HMPSRC=$P(HMPSRC,U)
D DEFSORT^ORQPTQ11(.HMPSORT)
D DEFLIST^ORQPTQ11(.HMPOUT)
S GSOURCE=$S(LISTIEN>0:$$STGSRCE(HMPSRC,LISTIEN),1:"")
K ^TMP("HMPRESULT",$J),^TMP("HMPTEMP",$J),^TMP("HMPSORT",$J)
S CNT=0 F S CNT=$O(^TMP("OR",$J,"PATIENTS",CNT)) Q:CNT'>0 D
.S NODE=$G(^TMP("OR",$J,"PATIENTS",CNT,0))
.D BLDSORT(NODE,HMPSRC,HMPSORT,CNT)
K ^TMP("OR",$J)
D SRTSRC(HMPSORT,HMPSRC,$P($$FDEFSRC^ORQPTQ11(DUZ),U,2))
S GBL=$NA(^TMP("HMPSORT",$J)),CNT=0,LROOT=$L(GBL)-1,ROOT=$E(GBL,1,LROOT)
F S GBL=$Q(@GBL) Q:$E(GBL,1,LROOT)'=ROOT D
.S NODE=@GBL
.S CNT=CNT+1
.S DFN=$P(NODE,U),ROOM=$G(^DPT(DFN,.101)) ;ICR 10035 DE2818 ASF 11/12/15
.S PATIENTS(DFN)=""
.S PID=$$PID^HMPDJFS(DFN)
.S PATTYPE=$P(NODE,U,9)
.S APPT=$S(HMPSRC="M":$P(NODE,U,8),1:$P(NODE,U,4)),TYPE=$P(NODE,U,3),TYPEI=$P(NODE,U,7)
.S SOURCE=$S($G(GSOURCE)'="":GSOURCE,1:$$GTSOURCE(TYPE,TYPEI))
.S ISOUT=$S(PATTYPE="OPT":1,1:0)
.I $P(NODE,U,3)'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"sourceDisplayName")=$P(NODE,U,3)
.S ^TMP("HMPTEMP",$J,"data","patients",CNT,"pid")=PID
.S ^TMP("HMPTEMP",$J,"data","patients",CNT,"patientType")=$S(PATTYPE="OPT":"Outpatient",1:"Inpatient")
.I $G(APPT)'="" D SETAPPT(SOURCE,APPT,DFN,CNT)
.;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
.I $G(ROOM)'=""!(PATTYPE'="OPT") D STINP(DFN,CNT,ROOM)
.;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"roomBed")=ROOM
.D STPTSRC(SOURCE,CNT)
;
GETDLSTX ;
D ENCODE^HMPJSON($NA(^TMP("HMPTEMP",$J)),"RESULT","ERROR")
I SERVER'="" D CHKPAT(.PATIENTS,SERVER)
K ^TMP("HMPSORT",$J)
K ^TMP("HMPTEMP",$J)
Q
;
SETAPPT(SOURCE,APPT,DFN,CNT) ;
N LOC,UID,X
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
S UID=$P(SOURCE,U,2),LOC=$P($G(UID),":",5) I LOC'>0 Q
S X="A;"_APPT_";"_+LOC
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointmentUid")=$$SETUID^HMPUTILS("appointment",DFN,X)
Q
;
STINP(DFN,CNT,ROOM) ;
N LOC,NODE,UID,VAIN,WIEN
I ROOM'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"roomBed")=ROOM
D INP^VADPT I $G(VAIN(1))="" D KVA^VADPT Q
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"admissionUid")=$$SETUID^HMPUTILS("visit",DFN,"H"_VAIN(1))
S WIEN=+$G(VAIN(4)) I WIEN'>0 D KVA^VADPT Q
S LOC=+$G(^DIC(42,WIEN,44)) ;ICR 10040 DE2818 ASF 11/12/15
S NODE=$P($G(^SC(+LOC,0)),U,1,2) ;ICR 10040 DE2818 ASF 11/12/15
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"locationUid")=$$SETUID^HMPUTILS("location","",LOC,"")
I $P(NODE,U)'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"locationName")=$P(NODE,U)
I $P(NODE,U,2)'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"locationShortName")=$P(NODE,U,2)
D KVA^VADPT
Q
;
STPTSRC(SOURCE,CNT) ;
N UID,VAIN
S UID=$P(SOURCE,U,2)
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"sourceUid")=UID
I UID'["location" Q
S ^TMP("HMPTEMP",$J,"data","patients",CNT,"locationUid")=UID
I $P(SOURCE,U,3)'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"sourceName")=$P(SOURCE,U,3),^TMP("HMPTEMP",$J,"data","patients",CNT,"locationName")=$P(SOURCE,U,3)
I $P(SOURCE,U,4)'="" S ^TMP("HMPTEMP",$J,"data","patients",CNT,"sourceShortName")=$P(SOURCE,U,4),^TMP("HMPTEMP",$J,"data","patients",CNT,"locationShortName")=$P(SOURCE,U,4)
Q
;
LSTSRC(ADUZ) ; Return type of list source
; T:TeamList, W:Ward List, P:Provider List, S:Specialty List, C:Clinic List, M:Combination
N FROM,IEN,SRV
S:'$G(ADUZ) ADUZ=DUZ
S SRV=$G(^VA(200,ADUZ,5)) I +SRV>0 S SRV=$P(SRV,U) ;ICR 10060 DE2818 ASF 11/12/15
S FROM=$$GET^XPAR("USR.`"_ADUZ_"^SRV.`"_+$G(SRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
I FROM="M" Q FROM
I FROM="T" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(SRV),"ORLP DEFAULT TEAM",1,"Q") Q FROM_U_+$G(IEN)
I FROM="W" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(SRV),"ORLP DEFAULT WARD",1,"Q") Q FROM_U_+$G(IEN)
I FROM="P" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(SRV),"ORLP DEFAULT PROVIDER",1,"Q") Q FROM_U_+$G(IEN)
I FROM="S" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(SRV),"ORLP DEFAULT SPECIALTY",1,"Q") Q FROM_U_+$G(IEN)
I FROM="C" S API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),IEN=$$GET^XPAR("USR^SRV.`"_+$G(ORSRV),API,1,"Q") Q FROM_U_+$G(IEN)
Q FROM
;
GETCLIST(RESULT,SERVER,ID,START,END) ;
N APPT,CNT,DFN,ITR,NODE,PATIENTS,PID,SOURCE,TEMP,ERROR,HMPARRAY,HMPSORT,S
K ^TMP("HMPTEMP",$J)
D DEFSORT^ORQPTQ11(.HMPSORT)
D CLINPTS2^ORQPTQ2(.HMPARRAY,ID,START,END)
S SOURCE=$$GTSOURCE("Cl",ID)
S S=" " ; separator for sort
S CNT=0 F S CNT=$O(HMPARRAY(CNT)) Q:CNT'>0 D
. S NODE=$G(HMPARRAY(CNT))
. Q:$E(NODE)=U ; i.e., "^No appointments"
. I HMPSORT="P" S TEMP($P(NODE,U,4)_S_CNT)=NODE Q
. S TEMP($P(NODE,U,2)_S_$P(NODE,U,4)_S_CNT)=NODE
S CNT=0,ITR="" F S ITR=$O(TEMP(ITR)) Q:ITR="" D
. S NODE=TEMP(ITR),CNT=CNT+1
. S DFN=$P(NODE,U),APPT=$P(NODE,U,4)
. S PATIENTS(DFN)="",PID=$$PID^HMPDJFS(DFN)
. S ^TMP("HMPTEMP",$J,"data","patients",CNT,"pid")=PID
. S ^TMP("HMPTEMP",$J,"data","patients",CNT,"patientType")=$S($P(NODE,U,9)="OPT":"Outpatient",1:"Inpatient")
. I $G(APPT)'="" D SETAPPT(SOURCE,APPT,DFN,CNT)
. ;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
D SRTSRC(HMPSORT,"C",$P($G(^SC(ID,0)),U)) ;ICR 10040 DE2818 ASF 11/12/15
D ENCODE^HMPJSON($NA(^TMP("HMPTEMP",$J)),"RESULT","ERROR")
;I SERVER'="" D CHKPAT(.PATIENTS,SERVER) ; *S68-JCH*
Q
;
GTSOURCE(TYPE,INT) ;
N REC,RESULT,SPEC,SPECTYPE,UID
S SPEC=$P(TYPE," ")
S SPECTYPE=$S(SPEC="Cl":"Clinic",SPEC="Wd":"Ward",SPEC="Sp":"Treating Specality",SPEC="Pr":"Provider",SPEC="Tm":"OR Team",1:SPEC)
I SPECTYPE=SPEC Q SPEC_U_""
I SPECTYPE="Ward" S REC=+$G(^DIC(42,INT,44)) I REC'=INT S INT=REC ;ICR 10039 DE2818 ASF 11/12/15
S UID=$$SETUID^HMPUTILS($S(SPEC="Cl":"location",SPEC="Wd":"location",SPEC="Sp":"treatingSpecialty",SPEC="Pr":"provider",SPEC="Tm":"orTeam",1:SPEC),"",INT,"")
S RESULT=SPECTYPE_U_UID
I UID["location" S RESULT=RESULT_U_$P($G(^SC(+INT,0)),U,1,2)
Q RESULT
;
STGSRCE(SPEC,INT) ;
N REC,RESULT,SPECTYPE,UID
;T:TeamList, W:Ward List, P:Provider List, S:Specialty List, C:Clinic List, M:Combination
S RESULT=""
I "TWPSC"'[SPEC Q RESULT
S SPECTYPE=$S(SPEC="C":"Clinic",SPEC="W":"Ward",SPEC="S":"Treating Specality",SPEC="P":"Provider",SPEC="T":"OR Team",1:SPEC) I SPECTYPE=SPEC Q RESULT
I SPECTYPE="Ward" S REC=+$G(^DIC(42,INT,44)) I REC'=INT S INT=REC ;ICR 10039 DE2818 ASF 11/12/15
S UID=$$SETUID^HMPUTILS($S(SPEC="C":"location",SPEC="W":"location",SPEC="S":"treatingSpecialty",SPEC="P":"provider",SPEC="T":"orTeam",1:SPEC),"",INT,"")
S RESULT=SPECTYPE_U_UID
I UID["location" S RESULT=RESULT_U_$P($G(^SC(+INT,0)),U,1,2) ;ICR 10060 DE2818 ASF 11/12/15
Q RESULT
;
GETWLIST(RESULT,SERVER,ID) ;
N CNT,DFN,ITR,NODE,PATIENTS,PID,ROOM,TEMP,WARD,ERROR,HMPARRAY,HMPSORT
K ^TMP("HMPTEMP",$J)
D DEFSORT^ORQPTQ11(.HMPSORT)
D BYWARD^ORWPT(.HMPARRAY,ID)
S CNT=0 F S CNT=$O(HMPARRAY(CNT)) Q:CNT'>0 D
. S NODE=$G(HMPARRAY(CNT))
. Q:$E(NODE)=U ; i.e., "^No patients found"
. I HMPSORT="R" S TEMP($P(NODE,U,3)_" "_CNT)=NODE Q
. S TEMP($P(NODE,U,2)_" "_CNT)=NODE
S ITR="",CNT=0 F S ITR=$O(TEMP(ITR)) Q:ITR="" D
.S NODE=TEMP(ITR),CNT=CNT+1
.S DFN=$P(NODE,U),ROOM=$P(NODE,U,3)
.S PATIENTS(DFN)="",PID=$$PID^HMPDJFS(DFN)
.S ^TMP("HMPTEMP",$J,"data","patients",CNT,"pid")=PID
.D STINP(DFN,CNT,ROOM)
.;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"roomBed")=ROOM
D SRTSRC(HMPSORT,"W",$P($G(^DIC(42,ID,0)),U)) ;ICR 10039 DE2818 ASF 11/12/15
D ENCODE^HMPJSON($NA(^TMP("HMPTEMP",$J)),"RESULT","ERROR")
;I SERVER'="" D CHKPAT(.PATIENTS,SERVER) ; *S68-JCH*
Q
SRTSRC(SORT,SRCTYPE,SRCNAME) ; Set sort type, source type, source name
S ^TMP("HMPTEMP",$J,"data","defaultPatientListSourceType")=SRCTYPE
S ^TMP("HMPTEMP",$J,"data","defaultPatientListSourceName")=SRCNAME
S ^TMP("HMPTEMP",$J,"data","defaultPatientListSourceSort")=SORT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPROS8 9541 printed Sep 23, 2025@19:30:36 Page 2
HMPROS8 ;SLC/AGP,ASMR/RRB - Get CPRS User Default Roster List ; 6/11/14 8:38pm
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**;AUG 17, 2011;Build 63
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
BLDSORT(NODE,SRC,SORT,SEQ) ; emulate TStringList Sort found in CPRS
+1 ; append separator to ensure string sort (rather than numeric)
+2 ; append SEQ to avoid dropping node where SORTKEY is duplicated
+3 ; SORT: A:Alphabetic;R:Room/Bed;P:Appointment Date;T:Terminal Digit;S:Source
+4 ; i.e., "^No patients found"
IF $EXTRACT(NODE)=U
QUIT
+5 NEW SORTKEY,S
+6 SET NODE=$GET(NODE)
SET S=" "
+7 ; default alphabetic by name
SET SORTKEY=$PIECE(NODE,U,2)_S_SEQ
+8 IF SRC="C"
IF (SORT="P")
SET SORTKEY=$PIECE(NODE,U,4)_S_SEQ
+9 IF SRC="M"
Begin DoDot:1
+10 IF SORT="S"
SET SORTKEY=$PIECE(NODE,U,3)_S_$PIECE(NODE,U,8)_S_$PIECE(NODE,U,2)_S_SEQ
+11 IF SORT="P"
SET SORTKEY=$PIECE(NODE,U,8)_S_$PIECE(NODE,U,2)_S_SEQ
+12 IF SORT="T"
SET SORTKEY=$PIECE(NODE,U,5)_S_SEQ
End DoDot:1
+13 IF SRC="W"
IF (SORT="R")
SET SORTKEY=$PIECE(NODE,U,3)_S_$PIECE(NODE,U,2)_S_SEQ
+14 IF '$LENGTH(SORTKEY)
SET SORTKEY=S_SEQ
+15 SET ^TMP("HMPSORT",$JOB,$PIECE(SRC,U,2)_":"_SORT,SORTKEY)=NODE
+16 QUIT
+17 ;
CHKPAT(PATIENTS,SERVER) ;
+1 NEW ARGS,OUT,PAT,STATUS
+2 SET ARGS("command")="putPtSubscription"
+3 SET ARGS("server")=SERVER
+4 SET PAT=""
FOR
SET PAT=$ORDER(PATIENTS(PAT))
if PAT'>0
QUIT
Begin DoDot:1
+5 SET STATUS=$GET(^HMP(800000,"AITEM",PAT,SERVER))
+6 IF STATUS'=""
IF STATUS>0
QUIT
+7 SET ARGS("localId")=PAT
+8 DO API^HMPDJFS(.OUT,.ARGS)
End DoDot:1
+9 QUIT
+10 ;
GETDLIST(RESULT,SERVER) ;
+1 NEW APPT,ARRAY,DFN,CNT,ERROR,GBL,GSOURCE,ISOUT,LISTIEN,LROOT,NAME,NODE,PATIENTS
+2 NEW PATTYPE,PATUID,PID,ROOM,ROOT,SOURCE,SOURCETYPE,TYPE,TYPEI,HMPSRC,HMPSORT,HMPOUT
+3 NEW XOBDATA
SET XOBDATA(0)=1
+4 NEW XWBOS
SET XWBOS(0)=1
+5 KILL ^TMP("OR",$JOB)
+6 SET HMPSRC=$$LSTSRC(DUZ)
+7 SET LISTIEN=$PIECE(HMPSRC,U,2)
SET HMPSRC=$PIECE(HMPSRC,U)
+8 DO DEFSORT^ORQPTQ11(.HMPSORT)
+9 DO DEFLIST^ORQPTQ11(.HMPOUT)
+10 SET GSOURCE=$SELECT(LISTIEN>0:$$STGSRCE(HMPSRC,LISTIEN),1:"")
+11 KILL ^TMP("HMPRESULT",$JOB),^TMP("HMPTEMP",$JOB),^TMP("HMPSORT",$JOB)
+12 SET CNT=0
FOR
SET CNT=$ORDER(^TMP("OR",$JOB,"PATIENTS",CNT))
if CNT'>0
QUIT
Begin DoDot:1
+13 SET NODE=$GET(^TMP("OR",$JOB,"PATIENTS",CNT,0))
+14 DO BLDSORT(NODE,HMPSRC,HMPSORT,CNT)
End DoDot:1
+15 KILL ^TMP("OR",$JOB)
+16 DO SRTSRC(HMPSORT,HMPSRC,$PIECE($$FDEFSRC^ORQPTQ11(DUZ),U,2))
+17 SET GBL=$NAME(^TMP("HMPSORT",$JOB))
SET CNT=0
SET LROOT=$LENGTH(GBL)-1
SET ROOT=$EXTRACT(GBL,1,LROOT)
+18 FOR
SET GBL=$QUERY(@GBL)
if $EXTRACT(GBL,1,LROOT)'=ROOT
QUIT
Begin DoDot:1
+19 SET NODE=@GBL
+20 SET CNT=CNT+1
+21 ;ICR 10035 DE2818 ASF 11/12/15
SET DFN=$PIECE(NODE,U)
SET ROOM=$GET(^DPT(DFN,.101))
+22 SET PATIENTS(DFN)=""
+23 SET PID=$$PID^HMPDJFS(DFN)
+24 SET PATTYPE=$PIECE(NODE,U,9)
+25 SET APPT=$SELECT(HMPSRC="M":$PIECE(NODE,U,8),1:$PIECE(NODE,U,4))
SET TYPE=$PIECE(NODE,U,3)
SET TYPEI=$PIECE(NODE,U,7)
+26 SET SOURCE=$SELECT($GET(GSOURCE)'="":GSOURCE,1:$$GTSOURCE(TYPE,TYPEI))
+27 SET ISOUT=$SELECT(PATTYPE="OPT":1,1:0)
+28 IF $PIECE(NODE,U,3)'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"sourceDisplayName")=$PIECE(NODE,U,3)
+29 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"pid")=PID
+30 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"patientType")=$SELECT(PATTYPE="OPT":"Outpatient",1:"Inpatient")
+31 IF $GET(APPT)'=""
DO SETAPPT(SOURCE,APPT,DFN,CNT)
+32 ;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
+33 IF $GET(ROOM)'=""!(PATTYPE'="OPT")
DO STINP(DFN,CNT,ROOM)
+34 ;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"roomBed")=ROOM
+35 DO STPTSRC(SOURCE,CNT)
End DoDot:1
+36 ;
GETDLSTX ;
+1 DO ENCODE^HMPJSON($NAME(^TMP("HMPTEMP",$JOB)),"RESULT","ERROR")
+2 IF SERVER'=""
DO CHKPAT(.PATIENTS,SERVER)
+3 KILL ^TMP("HMPSORT",$JOB)
+4 KILL ^TMP("HMPTEMP",$JOB)
+5 QUIT
+6 ;
SETAPPT(SOURCE,APPT,DFN,CNT) ;
+1 NEW LOC,UID,X
+2 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
+3 SET UID=$PIECE(SOURCE,U,2)
SET LOC=$PIECE($GET(UID),":",5)
IF LOC'>0
QUIT
+4 SET X="A;"_APPT_";"_+LOC
+5 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"appointmentUid")=$$SETUID^HMPUTILS("appointment",DFN,X)
+6 QUIT
+7 ;
STINP(DFN,CNT,ROOM) ;
+1 NEW LOC,NODE,UID,VAIN,WIEN
+2 IF ROOM'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"roomBed")=ROOM
+3 DO INP^VADPT
IF $GET(VAIN(1))=""
DO KVA^VADPT
QUIT
+4 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"admissionUid")=$$SETUID^HMPUTILS("visit",DFN,"H"_VAIN(1))
+5 SET WIEN=+$GET(VAIN(4))
IF WIEN'>0
DO KVA^VADPT
QUIT
+6 ;ICR 10040 DE2818 ASF 11/12/15
SET LOC=+$GET(^DIC(42,WIEN,44))
+7 ;ICR 10040 DE2818 ASF 11/12/15
SET NODE=$PIECE($GET(^SC(+LOC,0)),U,1,2)
+8 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationUid")=$$SETUID^HMPUTILS("location","",LOC,"")
+9 IF $PIECE(NODE,U)'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationName")=$PIECE(NODE,U)
+10 IF $PIECE(NODE,U,2)'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationShortName")=$PIECE(NODE,U,2)
+11 DO KVA^VADPT
+12 QUIT
+13 ;
STPTSRC(SOURCE,CNT) ;
+1 NEW UID,VAIN
+2 SET UID=$PIECE(SOURCE,U,2)
+3 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"sourceUid")=UID
+4 IF UID'["location"
QUIT
+5 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationUid")=UID
+6 IF $PIECE(SOURCE,U,3)'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"sourceName")=$PIECE(SOURCE,U,3)
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationName")=$PIECE(SOURCE,U,3)
+7 IF $PIECE(SOURCE,U,4)'=""
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"sourceShortName")=$PIECE(SOURCE,U,4)
SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"locationShortName")=$PIECE(SOURCE,U,4)
+8 QUIT
+9 ;
LSTSRC(ADUZ) ; Return type of list source
+1 ; T:TeamList, W:Ward List, P:Provider List, S:Specialty List, C:Clinic List, M:Combination
+2 NEW FROM,IEN,SRV
+3 if '$GET(ADUZ)
SET ADUZ=DUZ
+4 ;ICR 10060 DE2818 ASF 11/12/15
SET SRV=$GET(^VA(200,ADUZ,5))
IF +SRV>0
SET SRV=$PIECE(SRV,U)
+5 SET FROM=$$GET^XPAR("USR.`"_ADUZ_"^SRV.`"_+$GET(SRV),"ORLP DEFAULT LIST SOURCE",1,"Q")
+6 IF FROM="M"
QUIT FROM
+7 IF FROM="T"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(SRV),"ORLP DEFAULT TEAM",1,"Q")
QUIT FROM_U_+$GET(IEN)
+8 IF FROM="W"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(SRV),"ORLP DEFAULT WARD",1,"Q")
QUIT FROM_U_+$GET(IEN)
+9 IF FROM="P"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(SRV),"ORLP DEFAULT PROVIDER",1,"Q")
QUIT FROM_U_+$GET(IEN)
+10 IF FROM="S"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(SRV),"ORLP DEFAULT SPECIALTY",1,"Q")
QUIT FROM_U_+$GET(IEN)
+11 IF FROM="C"
SET API="ORLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(ORSRV),API,1,"Q")
QUIT FROM_U_+$GET(IEN)
+12 QUIT FROM
+13 ;
GETCLIST(RESULT,SERVER,ID,START,END) ;
+1 NEW APPT,CNT,DFN,ITR,NODE,PATIENTS,PID,SOURCE,TEMP,ERROR,HMPARRAY,HMPSORT,S
+2 KILL ^TMP("HMPTEMP",$JOB)
+3 DO DEFSORT^ORQPTQ11(.HMPSORT)
+4 DO CLINPTS2^ORQPTQ2(.HMPARRAY,ID,START,END)
+5 SET SOURCE=$$GTSOURCE("Cl",ID)
+6 ; separator for sort
SET S=" "
+7 SET CNT=0
FOR
SET CNT=$ORDER(HMPARRAY(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+8 SET NODE=$GET(HMPARRAY(CNT))
+9 ; i.e., "^No appointments"
if $EXTRACT(NODE)=U
QUIT
+10 IF HMPSORT="P"
SET TEMP($PIECE(NODE,U,4)_S_CNT)=NODE
QUIT
+11 SET TEMP($PIECE(NODE,U,2)_S_$PIECE(NODE,U,4)_S_CNT)=NODE
End DoDot:1
+12 SET CNT=0
SET ITR=""
FOR
SET ITR=$ORDER(TEMP(ITR))
if ITR=""
QUIT
Begin DoDot:1
+13 SET NODE=TEMP(ITR)
SET CNT=CNT+1
+14 SET DFN=$PIECE(NODE,U)
SET APPT=$PIECE(NODE,U,4)
+15 SET PATIENTS(DFN)=""
SET PID=$$PID^HMPDJFS(DFN)
+16 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"pid")=PID
+17 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"patientType")=$SELECT($PIECE(NODE,U,9)="OPT":"Outpatient",1:"Inpatient")
+18 IF $GET(APPT)'=""
DO SETAPPT(SOURCE,APPT,DFN,CNT)
+19 ;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"appointment")=$$JSONDT^HMPUTILS(APPT)
End DoDot:1
+20 ;ICR 10040 DE2818 ASF 11/12/15
DO SRTSRC(HMPSORT,"C",$PIECE($GET(^SC(ID,0)),U))
+21 DO ENCODE^HMPJSON($NAME(^TMP("HMPTEMP",$JOB)),"RESULT","ERROR")
+22 ;I SERVER'="" D CHKPAT(.PATIENTS,SERVER) ; *S68-JCH*
+23 QUIT
+24 ;
GTSOURCE(TYPE,INT) ;
+1 NEW REC,RESULT,SPEC,SPECTYPE,UID
+2 SET SPEC=$PIECE(TYPE," ")
+3 SET SPECTYPE=$SELECT(SPEC="Cl":"Clinic",SPEC="Wd":"Ward",SPEC="Sp":"Treating Specality",SPEC="Pr":"Provider",SPEC="Tm":"OR Team",1:SPEC)
+4 IF SPECTYPE=SPEC
QUIT SPEC_U_""
+5 ;ICR 10039 DE2818 ASF 11/12/15
IF SPECTYPE="Ward"
SET REC=+$GET(^DIC(42,INT,44))
IF REC'=INT
SET INT=REC
+6 SET UID=$$SETUID^HMPUTILS($SELECT(SPEC="Cl":"location",SPEC="Wd":"location",SPEC="Sp":"treatingSpecialty",SPEC="Pr":"provider",SPEC="Tm":"orTeam",1:SPEC),"",INT,"")
+7 SET RESULT=SPECTYPE_U_UID
+8 IF UID["location"
SET RESULT=RESULT_U_$PIECE($GET(^SC(+INT,0)),U,1,2)
+9 QUIT RESULT
+10 ;
STGSRCE(SPEC,INT) ;
+1 NEW REC,RESULT,SPECTYPE,UID
+2 ;T:TeamList, W:Ward List, P:Provider List, S:Specialty List, C:Clinic List, M:Combination
+3 SET RESULT=""
+4 IF "TWPSC"'[SPEC
QUIT RESULT
+5 SET SPECTYPE=$SELECT(SPEC="C":"Clinic",SPEC="W":"Ward",SPEC="S":"Treating Specality",SPEC="P":"Provider",SPEC="T":"OR Team",1:SPEC)
IF SPECTYPE=SPEC
QUIT RESULT
+6 ;ICR 10039 DE2818 ASF 11/12/15
IF SPECTYPE="Ward"
SET REC=+$GET(^DIC(42,INT,44))
IF REC'=INT
SET INT=REC
+7 SET UID=$$SETUID^HMPUTILS($SELECT(SPEC="C":"location",SPEC="W":"location",SPEC="S":"treatingSpecialty",SPEC="P":"provider",SPEC="T":"orTeam",1:SPEC),"",INT,"")
+8 SET RESULT=SPECTYPE_U_UID
+9 ;ICR 10060 DE2818 ASF 11/12/15
IF UID["location"
SET RESULT=RESULT_U_$PIECE($GET(^SC(+INT,0)),U,1,2)
+10 QUIT RESULT
+11 ;
GETWLIST(RESULT,SERVER,ID) ;
+1 NEW CNT,DFN,ITR,NODE,PATIENTS,PID,ROOM,TEMP,WARD,ERROR,HMPARRAY,HMPSORT
+2 KILL ^TMP("HMPTEMP",$JOB)
+3 DO DEFSORT^ORQPTQ11(.HMPSORT)
+4 DO BYWARD^ORWPT(.HMPARRAY,ID)
+5 SET CNT=0
FOR
SET CNT=$ORDER(HMPARRAY(CNT))
if CNT'>0
QUIT
Begin DoDot:1
+6 SET NODE=$GET(HMPARRAY(CNT))
+7 ; i.e., "^No patients found"
if $EXTRACT(NODE)=U
QUIT
+8 IF HMPSORT="R"
SET TEMP($PIECE(NODE,U,3)_" "_CNT)=NODE
QUIT
+9 SET TEMP($PIECE(NODE,U,2)_" "_CNT)=NODE
End DoDot:1
+10 SET ITR=""
SET CNT=0
FOR
SET ITR=$ORDER(TEMP(ITR))
if ITR=""
QUIT
Begin DoDot:1
+11 SET NODE=TEMP(ITR)
SET CNT=CNT+1
+12 SET DFN=$PIECE(NODE,U)
SET ROOM=$PIECE(NODE,U,3)
+13 SET PATIENTS(DFN)=""
SET PID=$$PID^HMPDJFS(DFN)
+14 SET ^TMP("HMPTEMP",$JOB,"data","patients",CNT,"pid")=PID
+15 DO STINP(DFN,CNT,ROOM)
+16 ;S ^TMP("HMPTEMP",$J,"data","patients",CNT,"roomBed")=ROOM
End DoDot:1
+17 ;ICR 10039 DE2818 ASF 11/12/15
DO SRTSRC(HMPSORT,"W",$PIECE($GET(^DIC(42,ID,0)),U))
+18 DO ENCODE^HMPJSON($NAME(^TMP("HMPTEMP",$JOB)),"RESULT","ERROR")
+19 ;I SERVER'="" D CHKPAT(.PATIENTS,SERVER) ; *S68-JCH*
+20 QUIT
SRTSRC(SORT,SRCTYPE,SRCNAME) ; Set sort type, source type, source name
+1 SET ^TMP("HMPTEMP",$JOB,"data","defaultPatientListSourceType")=SRCTYPE
+2 SET ^TMP("HMPTEMP",$JOB,"data","defaultPatientListSourceName")=SRCNAME
+3 SET ^TMP("HMPTEMP",$JOB,"data","defaultPatientListSourceSort")=SORT
+4 QUIT
