- 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 Feb 18, 2025@23:20:56 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