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

YSBDD1.m

Go to the documentation of this file.
  1. YSBDD1 ;SLC/DSB - MHA DASHBOARD Drilldown ; Apr 01, 2021@16:30
  1. ;;5.01;MENTAL HEALTH;**202**;Dec 30, 1994;Build 47
  1. ;
  1. ; Reference to DEM^VADPT in ICR #7109
  1. ; Reference to ^DGPF(26.15,"B") in ICR #5991
  1. ; Reference to SDAPI^SDAMA301 in ICR #4433
  1. ; Reference to GETINF^DGPFAPIH in ICR #4903
  1. ; Reference to TIUSRVL in ICR #2812
  1. Q
  1. PATIENT(DFN,DATAOUT) ;
  1. N VADM,VAPA
  1. D DEM^VADPT
  1. D ADD^VADPT
  1. S DATAOUT("patient_information","name")=VADM(1)
  1. S DATAOUT("patient_information","sex")=$P(VADM(5),U,2)
  1. S DATAOUT("patient_information","dob")=$P(VADM(3),U,2)
  1. S DATAOUT("patient_information","age")=VADM(4)
  1. S DATAOUT("patient_information","social")=$P(VADM(2),U,2)
  1. S DATAOUT("patient_information","address1")=VAPA(1)
  1. S DATAOUT("patient_information","address2")=VAPA(2)
  1. S DATAOUT("patient_information","address3")=VAPA(3)
  1. S DATAOUT("patient_information","city")=VAPA(4)
  1. S DATAOUT("patient_information","state")=$P(VAPA(5),U,2)
  1. S DATAOUT("patient_information","zipcode")=VAPA(6)
  1. S DATAOUT("patient_information","phone_number")=VAPA(8)
  1. S DATAOUT("patient_information","cell_phone")=$P($G(^DPT(DFN,.13)),U,4)
  1. Q
  1. ;
  1. HRPTPROF(JSONOUT,DFN) ;
  1. N PRFNAME,IDX,YSDARRAY,SDCOUNT,NOW,YSDT,SDTIME,HRRVWDT,DHRR,TIUIDX,DATAOUT,ERRARY,PIDX,FIDX,TIUINVDT,DATEFOUND,SAFHEAD,SAFDCL,CSREHEAD
  1. N APPTLIST,NODE,OUTPXENC,IEN,PRV,PRVLIST,FTRLIST,DATE,ENCOUNTER,I,YSVISIT,NIDX,STATUS,PREFS,OPCUT
  1. N PATTYP
  1. N SAFSCNO,SAFSCYES,CSRENEW,CSREUPD,SITES,HFCLIST,SAFREV
  1. S NOW=$$NOW^XLFDT
  1. S YSDT=$P(NOW,".",1)
  1. D HRINIT^YSBRPC(.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.CSREHEAD,.CSRENEW,.CSREUPD,.SITES)
  1. ;D GETLST^XPAR(.SAFHFC,"SYS","YSB SAFETY PLAN HF CATEGORY")
  1. ;D GETLST^XPAR(.SAFHEAD,"SYS","YSB SAFETY PLAN HEADER TEXT")
  1. ;D GETLST^XPAR(.SAFDCL,"SYS","YSB SAFETY PLAN DECLINE")
  1. ;D GETLST^XPAR(.CSREHFC,"SYS","YSB CSRE HF CATEGORY")
  1. ;D GETLST^XPAR(.CSREHEAD,"SYS","YSB CSRE HEADER TEXT")
  1. S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"flag_name")=""
  1. S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"review_date")=""
  1. S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"due/overdue")=""
  1. S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"prf_actions")=""
  1. S DATAOUT("high_risk_patient_profile","patient_record_flag",1,"action_date")=""
  1. S (HRRVWDT,DHRR)=0
  1. S (PRFNAME,PRFIEN,IDX)=0 F S PRFNAME=$O(^DGPF(26.15,"B",PRFNAME)) Q:PRFNAME']"" D
  1. .N PRFIEN,RSLT,PRFDATA,HISTIDX,LSTHIST,PRFACT,NXTHIDX,NXTHDT
  1. .S PRFIEN=$O(^DGPF(26.15,"B",PRFNAME,""))
  1. .S RSLT=$$GETINF^DGPFAPIH(DFN,PRFIEN_";DGPF(26.15,","","","PRFDATA")
  1. .I RSLT=0 Q
  1. .S LSTHIST=$O(PRFDATA("HIST",""),-1)
  1. .S HISTIDX="A" F S HISTIDX=$O(PRFDATA("HIST",HISTIDX),-1) Q:'HISTIDX D
  1. ..S IDX=IDX+1
  1. ..S PRFACT=$P(PRFDATA("HIST",HISTIDX,"ACTION"),U,2)
  1. ..S NXTHIDX=$O(PRFDATA("HIST",HISTIDX))
  1. ..S NXTHDT="UNK" ;I NXTHIDX]"" S NXTHDT=$P($P($G(PRFDATA("HIST",NXTHIDX,"DATETIME")),U,2),"@")
  1. ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"flag_name")=PRFNAME
  1. ..I $P(PRFDATA("REVIEWDT"),U,2)="" S $P(PRFDATA("REVIEWDT"),U,2)="N/A"
  1. ..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
  1. ..I PRFIEN=2 D ;save the High Risk dates for later use
  1. ...I $$FMTH^XLFDT($P(PRFDATA("REVIEWDT"),U,1),1)'>DHRR Q
  1. ...S HRRVWDT=$P(PRFDATA("REVIEWDT"),U,1),DHRR=$$FMTH^XLFDT($P(PRFDATA("REVIEWDT"),U,1),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")
  1. ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"prf_actions")=PRFACT
  1. ..S DATAOUT("high_risk_patient_profile","patient_record_flag",IDX,"action_date")=$P($P(PRFDATA("HIST",HISTIDX,"DATETIME"),U,2),"@")
  1. ; scheduled appointments
  1. K ^TMP($J,"SDAMA301")
  1. N FROMTO
  1. ;S FROMTO=91
  1. S FROMTO=365
  1. S YSDARRAY(1)=$$FMADD^XLFDT(YSDT,-FROMTO)_";"_$$FMADD^XLFDT(YSDT,FROMTO)
  1. S YSDARRAY(3)="R;I;NS;NSR;CC;CCR;CP;CPR;NT;"
  1. S YSDARRAY(4)=DFN
  1. S YSDARRAY("FLDS")="1;2;12;13;18;22"
  1. S YSDARRAY("SORT")="P"
  1. S SDCOUNT=$$SDAPI^SDAMA301(.YSDARRAY)
  1. M APPTLIST=^TMP($J,"SDAMA301",DFN)
  1. ;add ^SCE("ADFN" loop to detect Outpatient Encounters with no visit. These will be marked as unscheduled
  1. S (PIDX,FIDX)=0
  1. S SDTIME=$$FMADD^XLFDT(YSDT,-FROMTO-1),OPCUT=$$FMADD^XLFDT(YSDT,FROMTO)
  1. F S SDTIME=$O(^SCE("ADFN",DFN,SDTIME)) Q:'SDTIME!(SDTIME>OPCUT) D
  1. .I $D(APPTLIST(SDTIME)) Q ;already got this visit, must be scheduled
  1. .S OUTPXENC=$O(^SCE("ADFN",DFN,SDTIME,0))
  1. .S NODE=^SCE(OUTPXENC,0)
  1. .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"
  1. ; split appointments into past and previous
  1. ;sort previous appointments by reverse date
  1. S SDTIME=NOW-.000001
  1. F S SDTIME=$O(APPTLIST(SDTIME),-1) Q:'SDTIME D
  1. .I '$$CHKCLIN(APPTLIST(SDTIME)) K APPTLIST(SDTIME) Q ;not ED or MH clinic - delete
  1. .I $P(APPTLIST(SDTIME),U,22)="11;FUTURE;FUTURE" Q ;in the future, possible for an appt later today
  1. .S PIDX=PIDX+1
  1. .S PRVLIST(PIDX)=APPTLIST(SDTIME)
  1. .K APPTLIST(SDTIME)
  1. ;sort future appointments - all previous appts are deleted
  1. S SDTIME=0 F S SDTIME=$O(APPTLIST(SDTIME)) Q:'SDTIME D
  1. .I '$$CHKCLIN(APPTLIST(SDTIME)) Q
  1. .S FIDX=FIDX+1
  1. .S FTRLIST(FIDX)=APPTLIST(SDTIME)
  1. ; handle previous appointments
  1. N PSTAT
  1. S PIDX=0 F S PIDX=$O(PRVLIST(PIDX)) Q:'PIDX D
  1. .S NIDX=0
  1. .S NODE=PRVLIST(PIDX)
  1. .S STATUS=$P(NODE,U,22),PSTAT=$P(STATUS,";",3)
  1. .S STATUS=$P($P($P(NODE,U,22),";",3)," &") ; also removes " & AUTO-REBOOK"
  1. .I STATUS["NO ACTION TAKEN",(PSTAT'["CHECKED") Q ;No positive state of this encounter.
  1. .I STATUS["NO ACT TAKN",(PSTAT'["CHECKED") Q ;Inpatient No action taken
  1. .I PSTAT["CHECKED" S STATUS=PSTAT ;For Checked In/Checked Out replace NO ACTION TAKEN status
  1. .S SDTIME=+NODE
  1. .S ENCOUNTER=$P(NODE,U,12)
  1. .S YSVISIT="" I ENCOUNTER S YSVISIT=$P(^SCE(ENCOUNTER,0),U,5)
  1. .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"location")=$P($P(NODE,U,2),";",2)
  1. .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
  1. .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")="N/A"
  1. .S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")=$P($P(NODE,U,22),";",3)
  1. .I YSVISIT D
  1. ..S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="COMPLETED"
  1. ..I $P(NODE,U,18)="4;UV" S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"status")="WALK-IN"
  1. ..S (IEN,PRV)="" F S IEN=$O(^AUPNVPRV("AD",YSVISIT,IEN)) Q:'IEN D Q:PRV ;DBIA 2316
  1. ...S NODE=^AUPNVPRV(IEN,0)
  1. ...I $P(NODE,U,4)="P" S PRV=+NODE
  1. ...Q
  1. ..I PRV D
  1. ...S PRV=$$GET1^DIQ(200,PRV_",",.01)
  1. ...S $P(PRV,",",2)=" "_$P(PRV,",",2) ;add a space between last and first name so GUI column can wrap
  1. ...S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"provider")=PRV
  1. ..K ^TMP("TIULIST",$J)
  1. ..D NOTES^TIUSRVLV("",YSVISIT)
  1. ..;loop through ^TMP("TIULIST",$J) and set TIUDA to each value
  1. ..S DATE="" F S DATE=$O(^TMP("TIULIST",$J,DATE)) Q:'DATE D
  1. ...S I="" F S I=$O(^TMP("TIULIST",$J,DATE,I)) Q:'I D
  1. ....I $P(^TMP("TIULIST",$J,DATE,I),U,7)'="completed" Q ;only completed (signed) notes.
  1. ....S NIDX=NIDX+1
  1. ....S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docID")=+^TMP("TIULIST",$J,DATE,I)
  1. ....S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes",NIDX,"docName")=$P(^TMP("TIULIST",$J,DATE,I),U,2)
  1. .I 'NIDX S DATAOUT("high_risk_patient_profile","previous_activity",PIDX,"notes")=""
  1. ; handle future appointments
  1. S FIDX=0 F S FIDX=$O(FTRLIST(FIDX)) Q:'FIDX D
  1. .S NODE=FTRLIST(FIDX)
  1. .S SDTIME=+NODE
  1. .S DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"location")=$P($P(NODE,U,2),";",2)
  1. .S DATAOUT("high_risk_patient_profile","future_appointments",FIDX,"date")=$$FMTE^XLFDT(SDTIME,5)
  1. K ^TMP($J,"SDAMA301")
  1. I '$D(DATAOUT("high_risk_patient_profile","previous_activity")) S DATAOUT("high_risk_patient_profile","previous_activity",1)=""
  1. I '$D(DATAOUT("high_risk_patient_profile","future_appointments")) S DATAOUT("high_risk_patient_profile","future_appointments",1)=""
  1. ; review status
  1. N DSTAT
  1. S PATTYP=$$MHDCDT^YSBWHIG2(DFN) S:PATTYP'="INPT" PATTYP="" ;Will return INPT if still an inpatient.
  1. S DSTAT=$$DONE7^YSBWHIGH(DFN,YSDT,.SAFHEAD,.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES)
  1. S DATAOUT("high_risk_patient_profile","review_status","review_due")=$$GETDUE^YSBWHIGH(HRRVWDT,YSDT)
  1. S DATAOUT("high_risk_patient_profile","review_status","on_track")=$$ONTRK^YSBWHIGH(DFN,"")
  1. S DATAOUT("high_risk_patient_profile","review_status","done_in_7")=DSTAT
  1. S DATAOUT("high_risk_patient_profile","review_status","done_in_7_number")=$$DONENUM(NOW)
  1. S DATAOUT("high_risk_patient_profile","review_status","inpatient")=PATTYP
  1. ; safety plan
  1. N TIUFND
  1. S TIUINVDT=0,IDX=0,TIUFND=1
  1. D SAFLST^YSBWHIGH(.SAFDCL,.SAFREV,.SAFSCNO,.SAFSCYES,.HFCLIST)
  1. F S DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.SAFHEAD,.TIUIDX,TIUFND) Q:'TIUINVDT D
  1. .S IDX=IDX+1
  1. .S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"docID")=TIUIDX
  1. .I $$SAFDECL^YSBWHIGH(DFN,TIUINVDT) S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")="Declined" Q
  1. .S DATAOUT("high_risk_patient_profile","safety_plan",IDX,"date")=$$FMTE^XLFDT($P(DATEFOUND,"."),5)
  1. I 'IDX S DATAOUT("high_risk_patient_profile","safety_plan",1,"date")="Not Done"
  1. ;CSRE
  1. K HFCLIST
  1. D CSRELST^YSBWHIGH(.CSRENEW,.CSREUPD,.HFCLIST)
  1. S TIUINVDT=0,IDX=0 F S DATEFOUND=$$FINDDOC^YSBWHIGH(DFN,.TIUINVDT,.HFCLIST,.CSREHEAD,.TIUIDX,TIUFND) Q:'TIUINVDT D
  1. .S IDX=IDX+1
  1. .S DATAOUT("high_risk_patient_profile","CSRE",IDX,"date")=$$FMTE^XLFDT($P(DATEFOUND,"."),5)
  1. .S DATAOUT("high_risk_patient_profile","CSRE",IDX,"docID")=TIUIDX
  1. I 'IDX S DATAOUT("high_risk_patient_profile","CSRE",1,"date")="Not Done"
  1. D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
  1. K ^TMP($J,"SDAMA301")
  1. K ^TMP("TIULIST",$J)
  1. Q
  1. WEBPROF(ARGS,RESULTS) ; MHA Web call for HRPTPROF
  1. N DFN,JSONOUT
  1. S DFN=$G(ARGS("dfn"))
  1. I DFN="" D SETERROR^YTQRUTL(404,"Patient ID not sent.") QUIT
  1. D HRPTPROF(.JSONOUT,DFN)
  1. D TOTMP^YSBRPC(.JSONOUT)
  1. S RESULTS=$NA(^TMP("YTQ-JSON",$J))
  1. Q
  1. ;
  1. DONENUM(TDT) ; Calculate the number of days for Done in 7
  1. N ACTDT,II,LST,RCNT,DIFF
  1. N NMSTR,NMARR,ACTSTR,ACTARR,LSTNM
  1. S NMARR("HIGH RISK FOR SUICIDE")=""
  1. S NMARR("BEHAVIORAL")=""
  1. S NMARR("MISSING PATIENT")=""
  1. S ACTARR("REACTIVATE")=""
  1. S ACTARR("CONTINUE")=""
  1. S ACTARR("NEW ASSIGNMENT")=""
  1. S RCNT=0,LST=0,LSTNM=""
  1. S II=0 F S II=$O(DATAOUT("high_risk_patient_profile","patient_record_flag",II)) Q:II="" D
  1. . S NMSTR=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"flag_name"))
  1. . I NMSTR]"" S LSTNM=NMSTR
  1. . I LSTNM]"" Q:'$D(NMARR(LSTNM)) ;Quit if we are not in a sequence of NEW/REACTIVATE/CONTINUE the Patient Record flags of interest
  1. . S ACTSTR=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"prf_actions"))
  1. . I ACTSTR]"" Q:'$D(ACTARR(ACTSTR))
  1. . S RCNT=$G(DATAOUT("high_risk_patient_profile","patient_record_flag",II,"action_date"))
  1. . S RCNT=$$ETF(RCNT)
  1. . I RCNT>LST S LST=RCNT
  1. S LST=$$FMTH^XLFDT(LST,1),LST=LST+7,LST=$$HTFM^XLFDT(LST,1)
  1. S DIFF=$$FMDIFF^XLFDT(LST,TDT,1)
  1. Q DIFF
  1. ETF(X) ; External to Fileman format
  1. N %DT,Y S X=$G(X),%DT="PST" D ^%DT S X=Y S:+X'>0 X="" Q X
  1. Q
  1. CHKCLIN(NODE) ;
  1. N STOPCODE
  1. S STOPCODE=$P($P(NODE,U,13),";",2)
  1. I STOPCODE=130 Q 1 ;ED clinic
  1. I (STOPCODE>499),(STOPCODE<600) Q 1 ;MH clinic
  1. Q 0 ;not ED or MH clinic
  1. ;
  1. GETNOTE(JSONOUT,YSTIUDA) ;
  1. N DATAOUT,YSTEXT
  1. ;note text
  1. D TGET^TIUSRVR1(.YSTEXT,YSTIUDA) ;TEXT just contains the string "^TMP("TIUVIEW",TIUDA)"
  1. S IDX=0 F S IDX=$O(@YSTEXT@(IDX)) Q:'IDX S DATAOUT("note_text",IDX,"line")=@YSTEXT@(IDX)
  1. I IDX=0 S DATAOUT("note_text",1)=""
  1. D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
  1. Q
  1. WEBNOTE(ARGS,RESULTS) ;MHA Web call for GETNOTE
  1. N YSTIUDA,JSONOUT
  1. S YSTIUDA=$G(ARGS("noteId"))
  1. I YSTIUDA="" D SETERROR^YTQRUTL(404,"Note ID not sent") QUIT
  1. D GETNOTE(.JSONOUT,YSTIUDA)
  1. D TOTMP^YSBRPC(.JSONOUT)
  1. S RESULTS=$NA(^TMP("YTQ-JSON",$J))
  1. Q
  1. ;
  1. GETRPRT(JSONOUT,ADMIN) ;
  1. N REPORT,DATAOUT,ERRARY
  1. K ^TMP("YTQRERRS",$J)
  1. D BLDRPT^YTQRRPT(.REPORT,ADMIN)
  1. I $D(REPORT) D
  1. .N IDX
  1. .S IDX=0 F S IDX=$O(REPORT(IDX)) Q:'IDX D
  1. ..S DATAOUT("report",IDX,"line")=REPORT(IDX)
  1. I '$D(REPORT) S DATAOUT("report",1,"line")="<no text>"
  1. I $D(^TMP("YTQRERRS",$J,1,"error")) D
  1. .S DATAOUT("report",1,"line")=^TMP("YTQRERRS",$J,1,"error","code")
  1. .S DATAOUT("report",2,"line")=^TMP("YTQRERRS",$J,1,"error","message")
  1. .S DATAOUT("report",3,"line")=^TMP("YTQRERRS",$J,1,"error","errors",1,"message")
  1. D ENCODE^YSBJSON("DATAOUT","JSONOUT","ERRARY")
  1. K ^TMP("YTQRERRS",$J)
  1. Q
  1. WEBRPRT(ARGS,RESULTS) ;
  1. N REPORT,DATAOUT,ERRARY,ADMIN,JSONOUT
  1. S ADMIN=$G(ARGS("adminId"))
  1. I ADMIN="" D SETERROR^YTQRUTL(404,"Admin ID not sent.") QUIT
  1. D GETRPRT(.JSONOUT,ADMIN)
  1. D TOTMP^YSBRPC(.JSONOUT)
  1. S RESULTS=$NA(^TMP("YTQ-JSON",$J))
  1. Q