- YSBDD1 ;SLC/DSB - MHA DASHBOARD Drilldown ; Apr 01, 2021@16:30
- ;;5.01;MENTAL HEALTH;**202**;Dec 30, 1994;Build 47
- ;
- ; Reference to DEM^VADPT in ICR #7109
- ; Reference to ^DGPF(26.15,"B") in ICR #5991
- ; Reference to SDAPI^SDAMA301 in ICR #4433
- ; Reference to GETINF^DGPFAPIH in ICR #4903
- ; Reference to TIUSRVL in ICR #2812
- Q
- PATIENT(DFN,DATAOUT) ;
- N VADM,VAPA
- D DEM^VADPT
- D ADD^VADPT
- S DATAOUT("patient_information","name")=VADM(1)
- S DATAOUT("patient_information","sex")=$P(VADM(5),U,2)
- S DATAOUT("patient_information","dob")=$P(VADM(3),U,2)
- S DATAOUT("patient_information","age")=VADM(4)
- S DATAOUT("patient_information","social")=$P(VADM(2),U,2)
- S DATAOUT("patient_information","address1")=VAPA(1)
- S DATAOUT("patient_information","address2")=VAPA(2)
- S DATAOUT("patient_information","address3")=VAPA(3)
- S DATAOUT("patient_information","city")=VAPA(4)
- S DATAOUT("patient_information","state")=$P(VAPA(5),U,2)
- S DATAOUT("patient_information","zipcode")=VAPA(6)
- S DATAOUT("patient_information","phone_number")=VAPA(8)
- S DATAOUT("patient_information","cell_phone")=$P($G(^DPT(DFN,.13)),U,4)
- Q
- ;
- HRPTPROF(JSONOUT,DFN) ;
- N PRFNAME,IDX,YSDARRAY,SDCOUNT,NOW,YSDT,SDTIME,HRRVWDT,DHRR,TIUIDX,DATAOUT,ERRARY,PIDX,FIDX,TIUINVDT,DATEFOUND,SAFHEAD,SAFDCL,CSREHEAD
- N APPTLIST,NODE,OUTPXENC,IEN,PRV,PRVLIST,FTRLIST,DATE,ENCOUNTER,I,YSVISIT,NIDX,STATUS,PREFS,OPCUT
- N PATTYP
- N SAFSCNO,SAFSCYES,CSRENEW,CSREUPD,SITES,HFCLIST,SAFREV
- S NOW=$$NOW^XLFDT
- S YSDT=$P(NOW,".",1)
- D HRINIT^YSBRPC(.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.CSREHEAD,.CSRENEW,.CSREUPD,.SITES)
- ;D GETLST^XPAR(.SAFHFC,"SYS","YSB SAFETY PLAN HF CATEGORY")
- ;D GETLST^XPAR(.SAFHEAD,"SYS","YSB SAFETY PLAN HEADER TEXT")
- ;D GETLST^XPAR(.SAFDCL,"SYS","YSB SAFETY PLAN DECLINE")
- ;D GETLST^XPAR(.CSREHFC,"SYS","YSB CSRE HF CATEGORY")
- ;D GETLST^XPAR(.CSREHEAD,"SYS","YSB CSRE HEADER TEXT")
- S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"flag_name")=""
- S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"review_date")=""
- S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"due/overdue")=""
- S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"prf_actions")=""
- S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"action_date")=""
- S (HRRVWDT,DHRR)=0
- S (PRFNAME,PRFIEN,IDX)=0 F S PRFNAME=$O(^DGPF(26.15,"B",PRFNAME)) Q:PRFNAME']"" D
- .N PRFIEN,RSLT,PRFDATA,HISTIDX,LSTHIST,PRFACT,NXTHIDX,NXTHDT
- .S PRFIEN=$O(^DGPF(26.15,"B",PRFNAME,""))
- .S RSLT=$$GETINF^DGPFAPIH(DFN,PRFIEN_";DGPF(26.15,","","","PRFDATA")
- .I RSLT=0 Q
- .S LSTHIST=$O(PRFDATA("HIST",""),-1)
- .S HISTIDX="A" F S HISTIDX=$O(PRFDATA("HIST",HISTIDX),-1) Q:'HISTIDX D
- ..S IDX=IDX+1
- ..S PRFACT=$P(PRFDATA("HIST",HISTIDX,"ACTION"),U,2)
- ..S NXTHIDX=$O(PRFDATA("HIST",HISTIDX))
- ..S NXTHDT="UNK" ;I NXTHIDX]"" S NXTHDT=$P($P($G(PRFDATA("HIST",NXTHIDX,"DATETIME")),U,2),"@")
- ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"flag_name")=PRFNAME
- ..I $P(PRFDATA("REVIEWDT"),U,2)="" S $P(PRFDATA("REVIEWDT"),U,2)="N/A"
- ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"review_date")=$S(HISTIDX=LSTHIST:$P(PRFDATA("REVIEWDT"),U,2),PRFACT="INACTIVATE":"N/A",1:NXTHDT) ;Need to review this later
- ..I PRFIEN=2 D ;save the High Risk dates for later use
- ...I $$FMTH^XLFDT($P(PRFDATA("REVIEWDT"),U,1),1)'>DHRR Q
- ...S HRRVWDT=$P(PRFDATA("REVIEWDT"),U,1),DHRR=$$FMTH^XLFDT($P(PRFDATA("REVIEWDT"),U,1),1)
- ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"due/overdue")=$S(HISTIDX=LSTHIST:$$GETDUE^YSBWHIGH($P(PRFDATA("REVIEWDT"),U),YSDT),PRFACT="INACTIVATE":"N/A",1:"UNK")
- ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"prf_actions")=PRFACT
- ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"action_date")=$P($P(PRFDATA("HIST",HISTIDX,"DATETIME"),U,2),"@")
- ; scheduled appointments
- K ^TMP($J,"SDAMA301")
- N FROMTO
- ;S FROMTO=91
- S FROMTO=365
- S YSDARRAY(1)=$$FMADD^XLFDT(YSDT,-FROMTO)_";"_$$FMADD^XLFDT(YSDT,FROMTO)
- S YSDARRAY(3)="R;I;NS;NSR;CC;CCR;CP;CPR;NT;"
- S YSDARRAY(4)=DFN
- S YSDARRAY("FLDS")="1;2;12;13;18;22"
- S YSDARRAY("SORT")="P"
- S SDCOUNT=$$SDAPI^SDAMA301(.YSDARRAY)
- M APPTLIST=^TMP($J,"SDAMA301",DFN)
- ;add ^SCE("ADFN" loop to detect Outpatient Encounters with no visit. These will be marked as unscheduled
- S (PIDX,FIDX)=0
- S SDTIME=$$FMADD^XLFDT(YSDT,-FROMTO-1),OPCUT=$$FMADD^XLFDT(YSDT,FROMTO)
- F S SDTIME=$O(^SCE("ADFN",DFN,SDTIME)) Q:'SDTIME!(SDTIME>OPCUT) D
- .I $D(APPTLIST(SDTIME)) Q ;already got this visit, must be scheduled
- .S OUTPXENC=$O(^SCE("ADFN",DFN,SDTIME,0))
- .S NODE=^SCE(OUTPXENC,0)
- .S APPTLIST(SDTIME)=SDTIME_U_$P(NODE,U,4)_";"_$$GET1^DIQ(44,$P(NODE,U,4),.01)_"^^^^^^^^^^"_OUTPXENC_U_$P(NODE,U,3)_";"_$$GET1^DIQ(40.7,$P(NODE,U,3),1)_"^^^^^4;UV^^^^;;WALK-IN"
- ; split appointments into past and previous
- ;sort previous appointments by reverse date
- S SDTIME=NOW-.000001
- F S SDTIME=$O(APPTLIST(SDTIME),-1) Q:'SDTIME D
- .I '$$CHKCLIN(APPTLIST(SDTIME)) K APPTLIST(SDTIME) Q ;not ED or MH clinic - delete
- .I $P(APPTLIST(SDTIME),U,22)="11;FUTURE;FUTURE" Q ;in the future, possible for an appt later today
- .S PIDX=PIDX+1
- .S PRVLIST(PIDX)=APPTLIST(SDTIME)
- .K APPTLIST(SDTIME)
- ;sort future appointments - all previous appts are deleted
- S SDTIME=0 F S SDTIME=$O(APPTLIST(SDTIME)) Q:'SDTIME D
- .I '$$CHKCLIN(APPTLIST(SDTIME)) Q
- .S FIDX=FIDX+1
- .S FTRLIST(FIDX)=APPTLIST(SDTIME)
- ; handle previous appointments
- N PSTAT
- S PIDX=0 F S PIDX=$O(PRVLIST(PIDX)) Q:'PIDX D
- .S NIDX=0
- .S NODE=PRVLIST(PIDX)
- .S STATUS=$P(NODE,U,22),PSTAT=$P(STATUS,";",3)
- .S STATUS=$P($P($P(NODE,U,22),";",3)," &") ; also removes " & AUTO-REBOOK"
- .I STATUS["NO ACTION TAKEN",(PSTAT'["CHECKED") Q ;No positive state of this encounter.
- .I STATUS["NO ACT TAKN",(PSTAT'["CHECKED") Q ;Inpatient No action taken
- .I PSTAT["CHECKED" S STATUS=PSTAT ;For Checked In/Checked Out replace NO ACTION TAKEN status
- .S SDTIME=+NODE
- .S ENCOUNTER=$P(NODE,U,12)
- .S YSVISIT="" I ENCOUNTER S YSVISIT=$P(^SCE(ENCOUNTER,0),U,5)
- .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"location")=$P($P(NODE,U,2),";",2)
- .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
- .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")="N/A"
- .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")=$P($P(NODE,U,22),";",3)
- .I YSVISIT D
- ..S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="COMPLETED"
- ..I $P(NODE,U,18)="4;UV" S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="WALK-IN"
- ..S (IEN,PRV)="" F S IEN=$O(^AUPNVPRV("AD",YSVISIT,IEN)) Q:'IEN D Q:PRV ;DBIA 2316
- ...S NODE=^AUPNVPRV(IEN,0)
- ...I $P(NODE,U,4)="P" S PRV=+NODE
- ...Q
- ..I PRV D
- ...S PRV=$$GET1^DIQ(200,PRV_",",.01)
- ...S $P(PRV,",",2)=" "_$P(PRV,",",2) ;add a space between last and first name so GUI column can wrap
- ...S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")=PRV
- ..K ^TMP("TIULIST",$J)
- ..D NOTES^TIUSRVLV("",YSVISIT)
- ..;loop through ^TMP("TIULIST",$J) and set TIUDA to each value
- ..S DATE="" F S DATE=$O(^TMP("TIULIST",$J,DATE)) Q:'DATE D
- ...S I="" F S I=$O(^TMP("TIULIST",$J,DATE,I)) Q:'I D
- ....I $P(^TMP("TIULIST",$J,DATE,I),U,7)'="completed" Q ;only completed (signed) notes.
- ....S NIDX=NIDX+1
- ....S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docID")=+^TMP("TIULIST",$J,DATE,I)
- ....S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docName")=$P(^TMP("TIULIST",$J,DATE,I),U,2)
- .I 'NIDX S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes")=""
- ; handle future appointments
- S FIDX=0 F S FIDX=$O(FTRLIST(FIDX)) Q:'FIDX D
- .S NODE=FTRLIST(FIDX)
- .S SDTIME=+NODE
- .S DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"location")=$P($P(NODE,U,2),";",2)
- .S DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
- K ^TMP($J,"SDAMA301")
- I '$D(DATAOUT("high_risk_patient_profile","previous_activity")) S DATAOUT("high_risk_patient_profile","previous_activity",1)=""
- I '$D(DATAOUT("high_risk_patient_profile","future_appointments")) S DATAOUT("high_risk_patient_profile","future_appointments",1)=""
- ; review status
- N DSTAT
- S PATTYP=$$MHDCDT^YSBWHIG2(DFN) S:PATTYP'="INPT" PATTYP="" ;Will return INPT if still an inpatient.
- S DSTAT=$$DONE7^YSBWHIGH(DFN,YSDT,.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES)
- S DATAOUT("high_risk_patient_profile","review_status","review_due")=$$GETDUE^YSBWHIGH(HRRVWDT,YSDT)
- S DATAOUT("high_risk_patient_profile","review_status","on_track")=$$ONTRK^YSBWHIGH(DFN,"")
- S DATAOUT("high_risk_patient_profile","review_status","done_in_7")=DSTAT
- S DATAOUT("high_risk_patient_profile","review_status","done_in_7_number")=$$DONENUM(NOW)
- S DATAOUT("high_risk_patient_profile","review_status","inpatient")=PATTYP
- ; safety plan
- N TIUFND
- S TIUINVDT=0,IDX=0,TIUFND=1
- D SAFLST^YSBWHIGH(.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.HFCLIST)
- F S DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.SAFHEAD,.TIUIDX,TIUFND) Q:'TIUINVDT D
- .S IDX=IDX+1
- .S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"docID")=TIUIDX
- .I $$SAFDECL^YSBWHIGH(DFN,TIUINVDT) S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")="Declined" Q
- .S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")=$$FMTE^XLFDT($P(DATEFOUND,"."),5)
- I 'IDX S DATAOUT("high_risk_patient_profile","safety_plan",1,"date")="Not Done"
- ;CSRE
- K HFCLIST
- D CSRELST^YSBWHIGH(.CSRENEW,.CSREUPD,.HFCLIST)
- S TIUINVDT=0,IDX=0 F S DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.CSREHEAD,.TIUIDX,TIUFND) Q:'TIUINVDT D
- .S IDX=IDX+1
- .S DATAOUT("high_risk_patient_profile","CSRE",IDX,"date")=$$FMTE^XLFDT($P(DATEFOUND,"."),5)
- .S DATAOUT("high_risk_patient_profile","CSRE",IDX,"docID")=TIUIDX
- I 'IDX S DATAOUT("high_risk_patient_profile","CSRE",1,"date")="Not Done"
- D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- K ^TMP($J,"SDAMA301")
- K ^TMP("TIULIST",$J)
- Q
- WEBPROF(ARGS,RESULTS) ; MHA Web call for HRPTPROF
- N DFN,JSONOUT
- S DFN=$G(ARGS("dfn"))
- I DFN="" D SETERROR^YTQRUTL(404,"Patient ID not sent.") QUIT
- D HRPTPROF(.JSONOUT,DFN)
- D TOTMP^YSBRPC(.JSONOUT)
- S RESULTS=$NA(^TMP("YTQ-JSON",$J))
- Q
- ;
- DONENUM(TDT) ; Calculate the number of days for Done in 7
- N ACTDT,II,LST,RCNT,DIFF
- N NMSTR,NMARR,ACTSTR,ACTARR,LSTNM
- S NMARR("HIGH RISK FOR SUICIDE")=""
- S NMARR("BEHAVIORAL")=""
- S NMARR("MISSING PATIENT")=""
- S ACTARR("REACTIVATE")=""
- S ACTARR("CONTINUE")=""
- S ACTARR("NEW ASSIGNMENT")=""
- S RCNT=0,LST=0,LSTNM=""
- S II=0 F S II=$O(DATAOUT("high_risk_patient_profile","patient_record_flag",II)) Q:II="" D
- . S NMSTR=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"flag_name"))
- . I NMSTR]"" S LSTNM=NMSTR
- . I LSTNM]"" Q:'$D(NMARR(LSTNM)) ;Quit if we are not in a sequence of NEW/REACTIVATE/CONTINUE the Patient Record flags of interest
- . S ACTSTR=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"prf_actions"))
- . I ACTSTR]"" Q:'$D(ACTARR(ACTSTR))
- . S RCNT=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"action_date"))
- . S RCNT=$$ETF(RCNT)
- . I RCNT>LST S LST=RCNT
- S LST=$$FMTH^XLFDT(LST,1),LST=LST+7,LST=$$HTFM^XLFDT(LST,1)
- S DIFF=$$FMDIFF^XLFDT(LST,TDT,1)
- Q DIFF
- ETF(X) ; External to Fileman format
- N %DT,Y S X=$G(X),%DT="PST" D ^%DT S X=Y S:+X'>0 X="" Q X
- Q
- CHKCLIN(NODE) ;
- N STOPCODE
- S STOPCODE=$P($P(NODE,U,13),";",2)
- I STOPCODE=130 Q 1 ;ED clinic
- I (STOPCODE>499),(STOPCODE<600) Q 1 ;MH clinic
- Q 0 ;not ED or MH clinic
- ;
- GETNOTE(JSONOUT,YSTIUDA) ;
- N DATAOUT,YSTEXT
- ;note text
- D TGET^TIUSRVR1(.YSTEXT,YSTIUDA) ;TEXT just contains the string "^TMP("TIUVIEW",TIUDA)"
- S IDX=0 F S IDX=$O(@YSTEXT@(IDX)) Q:'IDX S DATAOUT("note_text",IDX,"line")=@YSTEXT@(IDX)
- I IDX=0 S DATAOUT("note_text",1)=""
- D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- Q
- WEBNOTE(ARGS,RESULTS) ;MHA Web call for GETNOTE
- N YSTIUDA,JSONOUT
- S YSTIUDA=$G(ARGS("noteId"))
- I YSTIUDA="" D SETERROR^YTQRUTL(404,"Note ID not sent") QUIT
- D GETNOTE(.JSONOUT,YSTIUDA)
- D TOTMP^YSBRPC(.JSONOUT)
- S RESULTS=$NA(^TMP("YTQ-JSON",$J))
- Q
- ;
- GETRPRT(JSONOUT,ADMIN) ;
- N REPORT,DATAOUT,ERRARY
- K ^TMP("YTQRERRS",$J)
- D BLDRPT^YTQRRPT(.REPORT,ADMIN)
- I $D(REPORT) D
- .N IDX
- .S IDX=0 F S IDX=$O(REPORT(IDX)) Q:'IDX D
- ..S DATAOUT("report",IDX,"line")=REPORT(IDX)
- I '$D(REPORT) S DATAOUT("report",1,"line")="<no text>"
- I $D(^TMP("YTQRERRS",$J,1,"error")) D
- .S DATAOUT("report",1,"line")=^TMP("YTQRERRS",$J,1,"error","code")
- .S DATAOUT("report",2,"line")=^TMP("YTQRERRS",$J,1,"error","message")
- .S DATAOUT("report",3,"line")=^TMP("YTQRERRS",$J,1,"error","errors",1,"message")
- D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- K ^TMP("YTQRERRS",$J)
- Q
- WEBRPRT(ARGS,RESULTS) ;
- N REPORT,DATAOUT,ERRARY,ADMIN,JSONOUT
- S ADMIN=$G(ARGS("adminId"))
- I ADMIN="" D SETERROR^YTQRUTL(404,"Admin ID not sent.") QUIT
- D GETRPRT(.JSONOUT,ADMIN)
- D TOTMP^YSBRPC(.JSONOUT)
- S RESULTS=$NA(^TMP("YTQ-JSON",$J))
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HYSBDD1 13311 printed Feb 18, 2025@23:39:43 Page 2
- YSBDD1 ;SLC/DSB - MHA DASHBOARD Drilldown ; Apr 01, 2021@16:30
- +1 ;;5.01;MENTAL HEALTH;**202**;Dec 30, 1994;Build 47
- +2 ;
- +3 ; Reference to DEM^VADPT in ICR #7109
- +4 ; Reference to ^DGPF(26.15,"B") in ICR #5991
- +5 ; Reference to SDAPI^SDAMA301 in ICR #4433
- +6 ; Reference to GETINF^DGPFAPIH in ICR #4903
- +7 ; Reference to TIUSRVL in ICR #2812
- +8 QUIT
- PATIENT(DFN,DATAOUT) ;
- +1 NEW VADM,VAPA
- +2 DO DEM^VADPT
- +3 DO ADD^VADPT
- +4 SET DATAOUT("patient_information","name")=VADM(1)
- +5 SET DATAOUT("patient_information","sex")=$PIECE(VADM(5),U,2)
- +6 SET DATAOUT("patient_information","dob")=$PIECE(VADM(3),U,2)
- +7 SET DATAOUT("patient_information","age")=VADM(4)
- +8 SET DATAOUT("patient_information","social")=$PIECE(VADM(2),U,2)
- +9 SET DATAOUT("patient_information","address1")=VAPA(1)
- +10 SET DATAOUT("patient_information","address2")=VAPA(2)
- +11 SET DATAOUT("patient_information","address3")=VAPA(3)
- +12 SET DATAOUT("patient_information","city")=VAPA(4)
- +13 SET DATAOUT("patient_information","state")=$PIECE(VAPA(5),U,2)
- +14 SET DATAOUT("patient_information","zipcode")=VAPA(6)
- +15 SET DATAOUT("patient_information","phone_number")=VAPA(8)
- +16 SET DATAOUT("patient_information","cell_phone")=$PIECE($GET(^DPT(DFN,.13)),U,4)
- +17 QUIT
- +18 ;
- HRPTPROF(JSONOUT,DFN) ;
- +1 NEW PRFNAME,IDX,YSDARRAY,SDCOUNT,NOW,YSDT,SDTIME,HRRVWDT,DHRR,TIUIDX,DATAOUT,ERRARY,PIDX,FIDX,TIUINVDT,DATEFOUND,SAFHEAD,SAFDCL,CSREHEAD
- +2 NEW APPTLIST,NODE,OUTPXENC,IEN,PRV,PRVLIST,FTRLIST,DATE,ENCOUNTER,I,YSVISIT,NIDX,STATUS,PREFS,OPCUT
- +3 NEW PATTYP
- +4 NEW SAFSCNO,SAFSCYES,CSRENEW,CSREUPD,SITES,HFCLIST,SAFREV
- +5 SET NOW=$$NOW^XLFDT
- +6 SET YSDT=$PIECE(NOW,".",1)
- +7 DO HRINIT^YSBRPC(.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.CSREHEAD,.CSRENEW,.CSREUPD,.SITES)
- +8 ;D GETLST^XPAR(.SAFHFC,"SYS","YSB SAFETY PLAN HF CATEGORY")
- +9 ;D GETLST^XPAR(.SAFHEAD,"SYS","YSB SAFETY PLAN HEADER TEXT")
- +10 ;D GETLST^XPAR(.SAFDCL,"SYS","YSB SAFETY PLAN DECLINE")
- +11 ;D GETLST^XPAR(.CSREHFC,"SYS","YSB CSRE HF CATEGORY")
- +12 ;D GETLST^XPAR(.CSREHEAD,"SYS","YSB CSRE HEADER TEXT")
- +13 SET DATAOUT("high_risk_patient_profile","patient_record_flag",1,"flag_name")=""
- +14 SET DATAOUT("high_risk_patient_profile","patient_record_flag",1,"review_date")=""
- +15 SET DATAOUT("high_risk_patient_profile","patient_record_flag",1,"due/overdue")=""
- +16 SET DATAOUT("high_risk_patient_profile","patient_record_flag",1,"prf_actions")=""
- +17 SET DATAOUT("high_risk_patient_profile","patient_record_flag",1,"action_date")=""
- +18 SET (HRRVWDT,DHRR)=0
- +19 SET (PRFNAME,PRFIEN,IDX)=0
- FOR
- SET PRFNAME=$ORDER(^DGPF(26.15,"B",PRFNAME))
- if PRFNAME']""
- QUIT
- Begin DoDot:1
- +20 NEW PRFIEN,RSLT,PRFDATA,HISTIDX,LSTHIST,PRFACT,NXTHIDX,NXTHDT
- +21 SET PRFIEN=$ORDER(^DGPF(26.15,"B",PRFNAME,""))
- +22 SET RSLT=$$GETINF^DGPFAPIH(DFN,PRFIEN_";DGPF(26.15,","","","PRFDATA")
- +23 IF RSLT=0
- QUIT
- +24 SET LSTHIST=$ORDER(PRFDATA("HIST",""),-1)
- +25 SET HISTIDX="A"
- FOR
- SET HISTIDX=$ORDER(PRFDATA("HIST",HISTIDX),-1)
- if 'HISTIDX
- QUIT
- Begin DoDot:2
- +26 SET IDX=IDX+1
- +27 SET PRFACT=$PIECE(PRFDATA("HIST",HISTIDX,"ACTION"),U,2)
- +28 SET NXTHIDX=$ORDER(PRFDATA("HIST",HISTIDX))
- +29 ;I NXTHIDX]"" S NXTHDT=$P($P($G(PRFDATA("HIST",NXTHIDX,"DATETIME")),U,2),"@")
- SET NXTHDT="UNK"
- +30 SET DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"flag_name")=PRFNAME
- +31 IF $PIECE(PRFDATA("REVIEWDT"),U,2)=""
- SET $PIECE(PRFDATA("REVIEWDT"),U,2)="N/A"
- +32 ;Need to review this later
- SET DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"review_date")=$SELECT(HISTIDX=LSTHIST:$PIECE(PRFDATA("REVIEWDT"),U,2),PRFACT="INACTIVATE":"N/A",1:NXTHDT)
- +33 ;save the High Risk dates for later use
- IF PRFIEN=2
- Begin DoDot:3
- +34 IF $$FMTH^XLFDT($PIECE(PRFDATA("REVIEWDT"),U,1),1)'>DHRR
- QUIT
- +35 SET HRRVWDT=$PIECE(PRFDATA("REVIEWDT"),U,1)
- SET DHRR=$$FMTH^XLFDT($PIECE(PRFDATA("REVIEWDT"),U,1),1)
- End DoDot:3
- +36 SET DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"due/overdue")=$SELECT(HISTIDX=LSTHIST:$$GETDUE^YSBWHIGH($PIECE(PRFDATA("REVIEWDT"),U),YSDT),PRFACT="INACTIVATE":"N/A",1:"UNK")
- +37 SET DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"prf_actions")=PRFACT
- +38 SET DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"action_date")=$PIECE($PIECE(PRFDATA("HIST",HISTIDX,"DATETIME"),U,2),"@")
- End DoDot:2
- End DoDot:1
- +39 ; scheduled appointments
- +40 KILL ^TMP($JOB,"SDAMA301")
- +41 NEW FROMTO
- +42 ;S FROMTO=91
- +43 SET FROMTO=365
- +44 SET YSDARRAY(1)=$$FMADD^XLFDT(YSDT,-FROMTO)_";"_$$FMADD^XLFDT(YSDT,FROMTO)
- +45 SET YSDARRAY(3)="R;I;NS;NSR;CC;CCR;CP;CPR;NT;"
- +46 SET YSDARRAY(4)=DFN
- +47 SET YSDARRAY("FLDS")="1;2;12;13;18;22"
- +48 SET YSDARRAY("SORT")="P"
- +49 SET SDCOUNT=$$SDAPI^SDAMA301(.YSDARRAY)
- +50 MERGE APPTLIST=^TMP($JOB,"SDAMA301",DFN)
- +51 ;add ^SCE("ADFN" loop to detect Outpatient Encounters with no visit. These will be marked as unscheduled
- +52 SET (PIDX,FIDX)=0
- +53 SET SDTIME=$$FMADD^XLFDT(YSDT,-FROMTO-1)
- SET OPCUT=$$FMADD^XLFDT(YSDT,FROMTO)
- +54 FOR
- SET SDTIME=$ORDER(^SCE("ADFN",DFN,SDTIME))
- if 'SDTIME!(SDTIME>OPCUT)
- QUIT
- Begin DoDot:1
- +55 ;already got this visit, must be scheduled
- IF $DATA(APPTLIST(SDTIME))
- QUIT
- +56 SET OUTPXENC=$ORDER(^SCE("ADFN",DFN,SDTIME,0))
- +57 SET NODE=^SCE(OUTPXENC,0)
- +58 SET APPTLIST(SDTIME)=SDTIME_U_$PIECE(NODE,U,4)_";"_$$GET1^DIQ(44,$PIECE(NODE,U,4),.01)_"^^^^^^^^^^"_OUTPXENC_U_$PIECE(NODE,U,3)_";"_$$GET1^DIQ(40.7,$PIECE(NODE,U,3),1)_"^^^^^4;UV^^^^;;WALK-IN"
- End DoDot:1
- +59 ; split appointments into past and previous
- +60 ;sort previous appointments by reverse date
- +61 SET SDTIME=NOW-.000001
- +62 FOR
- SET SDTIME=$ORDER(APPTLIST(SDTIME),-1)
- if 'SDTIME
- QUIT
- Begin DoDot:1
- +63 ;not ED or MH clinic - delete
- IF '$$CHKCLIN(APPTLIST(SDTIME))
- KILL APPTLIST(SDTIME)
- QUIT
- +64 ;in the future, possible for an appt later today
- IF $PIECE(APPTLIST(SDTIME),U,22)="11;FUTURE;FUTURE"
- QUIT
- +65 SET PIDX=PIDX+1
- +66 SET PRVLIST(PIDX)=APPTLIST(SDTIME)
- +67 KILL APPTLIST(SDTIME)
- End DoDot:1
- +68 ;sort future appointments - all previous appts are deleted
- +69 SET SDTIME=0
- FOR
- SET SDTIME=$ORDER(APPTLIST(SDTIME))
- if 'SDTIME
- QUIT
- Begin DoDot:1
- +70 IF '$$CHKCLIN(APPTLIST(SDTIME))
- QUIT
- +71 SET FIDX=FIDX+1
- +72 SET FTRLIST(FIDX)=APPTLIST(SDTIME)
- End DoDot:1
- +73 ; handle previous appointments
- +74 NEW PSTAT
- +75 SET PIDX=0
- FOR
- SET PIDX=$ORDER(PRVLIST(PIDX))
- if 'PIDX
- QUIT
- Begin DoDot:1
- +76 SET NIDX=0
- +77 SET NODE=PRVLIST(PIDX)
- +78 SET STATUS=$PIECE(NODE,U,22)
- SET PSTAT=$PIECE(STATUS,";",3)
- +79 ; also removes " & AUTO-REBOOK"
- SET STATUS=$PIECE($PIECE($PIECE(NODE,U,22),";",3)," &")
- +80 ;No positive state of this encounter.
- IF STATUS["NO ACTION TAKEN"
- IF (PSTAT'["CHECKED")
- QUIT
- +81 ;Inpatient No action taken
- IF STATUS["NO ACT TAKN"
- IF (PSTAT'["CHECKED")
- QUIT
- +82 ;For Checked In/Checked Out replace NO ACTION TAKEN status
- IF PSTAT["CHECKED"
- SET STATUS=PSTAT
- +83 SET SDTIME=+NODE
- +84 SET ENCOUNTER=$PIECE(NODE,U,12)
- +85 SET YSVISIT=""
- IF ENCOUNTER
- SET YSVISIT=$PIECE(^SCE(ENCOUNTER,0),U,5)
- +86 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"location")=$PIECE($PIECE(NODE,U,2),";",2)
- +87 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
- +88 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")="N/A"
- +89 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")=$PIECE($PIECE(NODE,U,22),";",3)
- +90 IF YSVISIT
- Begin DoDot:2
- +91 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="COMPLETED"
- +92 IF $PIECE(NODE,U,18)="4;UV"
- SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="WALK-IN"
- +93 ;DBIA 2316
- SET (IEN,PRV)=""
- FOR
- SET IEN=$ORDER(^AUPNVPRV("AD",YSVISIT,IEN))
- if 'IEN
- QUIT
- Begin DoDot:3
- +94 SET NODE=^AUPNVPRV(IEN,0)
- +95 IF $PIECE(NODE,U,4)="P"
- SET PRV=+NODE
- +96 QUIT
- End DoDot:3
- if PRV
- QUIT
- +97 IF PRV
- Begin DoDot:3
- +98 SET PRV=$$GET1^DIQ(200,PRV_",",.01)
- +99 ;add a space between last and first name so GUI column can wrap
- SET $PIECE(PRV,",",2)=" "_$PIECE(PRV,",",2)
- +100 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")=PRV
- End DoDot:3
- +101 KILL ^TMP("TIULIST",$JOB)
- +102 DO NOTES^TIUSRVLV("",YSVISIT)
- +103 ;loop through ^TMP("TIULIST",$J) and set TIUDA to each value
- +104 SET DATE=""
- FOR
- SET DATE=$ORDER(^TMP("TIULIST",$JOB,DATE))
- if 'DATE
- QUIT
- Begin DoDot:3
- +105 SET I=""
- FOR
- SET I=$ORDER(^TMP("TIULIST",$JOB,DATE,I))
- if 'I
- QUIT
- Begin DoDot:4
- +106 ;only completed (signed) notes.
- IF $PIECE(^TMP("TIULIST",$JOB,DATE,I),U,7)'="completed"
- QUIT
- +107 SET NIDX=NIDX+1
- +108 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docID")=+^TMP("TIULIST",$JOB,DATE,I)
- +109 SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docName")=$PIECE(^TMP("TIULIST",$JOB,DATE,I),U,2)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +110 IF 'NIDX
- SET DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes")=""
- End DoDot:1
- +111 ; handle future appointments
- +112 SET FIDX=0
- FOR
- SET FIDX=$ORDER(FTRLIST(FIDX))
- if 'FIDX
- QUIT
- Begin DoDot:1
- +113 SET NODE=FTRLIST(FIDX)
- +114 SET SDTIME=+NODE
- +115 SET DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"location")=$PIECE($PIECE(NODE,U,2),";",2)
- +116 SET DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
- End DoDot:1
- +117 KILL ^TMP($JOB,"SDAMA301")
- +118 IF '$DATA(DATAOUT("high_risk_patient_profile","previous_activity"))
- SET DATAOUT("high_risk_patient_profile","previous_activity",1)=""
- +119 IF '$DATA(DATAOUT("high_risk_patient_profile","future_appointments"))
- SET DATAOUT("high_risk_patient_profile","future_appointments",1)=""
- +120 ; review status
- +121 NEW DSTAT
- +122 ;Will return INPT if still an inpatient.
- SET PATTYP=$$MHDCDT^YSBWHIG2(DFN)
- if PATTYP'="INPT"
- SET PATTYP=""
- +123 SET DSTAT=$$DONE7^YSBWHIGH(DFN,YSDT,.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES)
- +124 SET DATAOUT("high_risk_patient_profile","review_status","review_due")=$$GETDUE^YSBWHIGH(HRRVWDT,YSDT)
- +125 SET DATAOUT("high_risk_patient_profile","review_status","on_track")=$$ONTRK^YSBWHIGH(DFN,"")
- +126 SET DATAOUT("high_risk_patient_profile","review_status","done_in_7")=DSTAT
- +127 SET DATAOUT("high_risk_patient_profile","review_status","done_in_7_number")=$$DONENUM(NOW)
- +128 SET DATAOUT("high_risk_patient_profile","review_status","inpatient")=PATTYP
- +129 ; safety plan
- +130 NEW TIUFND
- +131 SET TIUINVDT=0
- SET IDX=0
- SET TIUFND=1
- +132 DO SAFLST^YSBWHIGH(.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.HFCLIST)
- +133 FOR
- SET DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.SAFHEAD,.TIUIDX,TIUFND)
- if 'TIUINVDT
- QUIT
- Begin DoDot:1
- +134 SET IDX=IDX+1
- +135 SET DATAOUT("high_risk_patient_profile","safety_plan",IDX,"docID")=TIUIDX
- +136 IF $$SAFDECL^YSBWHIGH(DFN,TIUINVDT)
- SET DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")="Declined"
- QUIT
- +137 SET DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")=$$FMTE^XLFDT($PIECE(DATEFOUND,"."),5)
- End DoDot:1
- +138 IF 'IDX
- SET DATAOUT("high_risk_patient_profile","safety_plan",1,"date")="Not Done"
- +139 ;CSRE
- +140 KILL HFCLIST
- +141 DO CSRELST^YSBWHIGH(.CSRENEW,.CSREUPD,.HFCLIST)
- +142 SET TIUINVDT=0
- SET IDX=0
- FOR
- SET DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.CSREHEAD,.TIUIDX,TIUFND)
- if 'TIUINVDT
- QUIT
- Begin DoDot:1
- +143 SET IDX=IDX+1
- +144 SET DATAOUT("high_risk_patient_profile","CSRE",IDX,"date")=$$FMTE^XLFDT($PIECE(DATEFOUND,"."),5)
- +145 SET DATAOUT("high_risk_patient_profile","CSRE",IDX,"docID")=TIUIDX
- End DoDot:1
- +146 IF 'IDX
- SET DATAOUT("high_risk_patient_profile","CSRE",1,"date")="Not Done"
- +147 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- +148 KILL ^TMP($JOB,"SDAMA301")
- +149 KILL ^TMP("TIULIST",$JOB)
- +150 QUIT
- WEBPROF(ARGS,RESULTS) ; MHA Web call for HRPTPROF
- +1 NEW DFN,JSONOUT
- +2 SET DFN=$GET(ARGS("dfn"))
- +3 IF DFN=""
- DO SETERROR^YTQRUTL(404,"Patient ID not sent.")
- QUIT
- +4 DO HRPTPROF(.JSONOUT,DFN)
- +5 DO TOTMP^YSBRPC(.JSONOUT)
- +6 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
- +7 QUIT
- +8 ;
- DONENUM(TDT) ; Calculate the number of days for Done in 7
- +1 NEW ACTDT,II,LST,RCNT,DIFF
- +2 NEW NMSTR,NMARR,ACTSTR,ACTARR,LSTNM
- +3 SET NMARR("HIGH RISK FOR SUICIDE")=""
- +4 SET NMARR("BEHAVIORAL")=""
- +5 SET NMARR("MISSING PATIENT")=""
- +6 SET ACTARR("REACTIVATE")=""
- +7 SET ACTARR("CONTINUE")=""
- +8 SET ACTARR("NEW ASSIGNMENT")=""
- +9 SET RCNT=0
- SET LST=0
- SET LSTNM=""
- +10 SET II=0
- FOR
- SET II=$ORDER(DATAOUT("high_risk_patient_profile","patient_record_flag",II))
- if II=""
- QUIT
- Begin DoDot:1
- +11 SET NMSTR=$GET(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"flag_name"))
- +12 IF NMSTR]""
- SET LSTNM=NMSTR
- +13 ;Quit if we are not in a sequence of NEW/REACTIVATE/CONTINUE the Patient Record flags of interest
- IF LSTNM]""
- if '$DATA(NMARR(LSTNM))
- QUIT
- +14 SET ACTSTR=$GET(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"prf_actions"))
- +15 IF ACTSTR]""
- if '$DATA(ACTARR(ACTSTR))
- QUIT
- +16 SET RCNT=$GET(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"action_date"))
- +17 SET RCNT=$$ETF(RCNT)
- +18 IF RCNT>LST
- SET LST=RCNT
- End DoDot:1
- +19 SET LST=$$FMTH^XLFDT(LST,1)
- SET LST=LST+7
- SET LST=$$HTFM^XLFDT(LST,1)
- +20 SET DIFF=$$FMDIFF^XLFDT(LST,TDT,1)
- +21 QUIT DIFF
- ETF(X) ; External to Fileman format
- +1 NEW %DT,Y
- SET X=$GET(X)
- SET %DT="PST"
- DO ^%DT
- SET X=Y
- if +X'>0
- SET X=""
- QUIT X
- +2 QUIT
- CHKCLIN(NODE) ;
- +1 NEW STOPCODE
- +2 SET STOPCODE=$PIECE($PIECE(NODE,U,13),";",2)
- +3 ;ED clinic
- IF STOPCODE=130
- QUIT 1
- +4 ;MH clinic
- IF (STOPCODE>499)
- IF (STOPCODE<600)
- QUIT 1
- +5 ;not ED or MH clinic
- QUIT 0
- +6 ;
- GETNOTE(JSONOUT,YSTIUDA) ;
- +1 NEW DATAOUT,YSTEXT
- +2 ;note text
- +3 ;TEXT just contains the string "^TMP("TIUVIEW",TIUDA)"
- DO TGET^TIUSRVR1(.YSTEXT,YSTIUDA)
- +4 SET IDX=0
- FOR
- SET IDX=$ORDER(@YSTEXT@(IDX))
- if 'IDX
- QUIT
- SET DATAOUT("note_text",IDX,"line")=@YSTEXT@(IDX)
- +5 IF IDX=0
- SET DATAOUT("note_text",1)=""
- +6 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- +7 QUIT
- WEBNOTE(ARGS,RESULTS) ;MHA Web call for GETNOTE
- +1 NEW YSTIUDA,JSONOUT
- +2 SET YSTIUDA=$GET(ARGS("noteId"))
- +3 IF YSTIUDA=""
- DO SETERROR^YTQRUTL(404,"Note ID not sent")
- QUIT
- +4 DO GETNOTE(.JSONOUT,YSTIUDA)
- +5 DO TOTMP^YSBRPC(.JSONOUT)
- +6 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
- +7 QUIT
- +8 ;
- GETRPRT(JSONOUT,ADMIN) ;
- +1 NEW REPORT,DATAOUT,ERRARY
- +2 KILL ^TMP("YTQRERRS",$JOB)
- +3 DO BLDRPT^YTQRRPT(.REPORT,ADMIN)
- +4 IF $DATA(REPORT)
- Begin DoDot:1
- +5 NEW IDX
- +6 SET IDX=0
- FOR
- SET IDX=$ORDER(REPORT(IDX))
- if 'IDX
- QUIT
- Begin DoDot:2
- +7 SET DATAOUT("report",IDX,"line")=REPORT(IDX)
- End DoDot:2
- End DoDot:1
- +8 IF '$DATA(REPORT)
- SET DATAOUT("report",1,"line")="<no text>"
- +9 IF $DATA(^TMP("YTQRERRS",$JOB,1,"error"))
- Begin DoDot:1
- +10 SET DATAOUT("report",1,"line")=^TMP("YTQRERRS",$JOB,1,"error","code")
- +11 SET DATAOUT("report",2,"line")=^TMP("YTQRERRS",$JOB,1,"error","message")
- +12 SET DATAOUT("report",3,"line")=^TMP("YTQRERRS",$JOB,1,"error","errors",1,"message")
- End DoDot:1
- +13 DO ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
- +14 KILL ^TMP("YTQRERRS",$JOB)
- +15 QUIT
- WEBRPRT(ARGS,RESULTS) ;
- +1 NEW REPORT,DATAOUT,ERRARY,ADMIN,JSONOUT
- +2 SET ADMIN=$GET(ARGS("adminId"))
- +3 IF ADMIN=""
- DO SETERROR^YTQRUTL(404,"Admin ID not sent.")
- QUIT
- +4 DO GETRPRT(.JSONOUT,ADMIN)
- +5 DO TOTMP^YSBRPC(.JSONOUT)
- +6 SET RESULTS=$NAME(^TMP("YTQ-JSON",$JOB))
- +7 QUIT