SDMHNS1 ;MAF/ALB - MENTAL HEALTH NO SHOW REPORT (BGJ CONT.);SEPTEMBER 9, 2010
;;5.3;Scheduling;**578,588**;Aug13,1993;Build 53
DATA ; Set up the data for the patient
; piece 1 = dfn
; piece 2 = Appointment Date and time
; piece 3 = status N(Noshow) or NA (Noshow with auto rebook)
; piece 4 = PID last 4 of SSN
; piece 5 = clinic ien ^SC(
; piece 6 = stop code ien ^DIC(40.7
;
;
EN ;PRINT OF THE ^TMP
N SDXDIV,SDXCLIN,SDXDFN,SDXSTOP,SDXREM,SDXNM,SDCOUNT,SDATE
S (SDXDFN,SDXREM,SDCOUNT)=0
I $D(^TMP(NAMSPC1,$J)) D TOTAL^SDMHNS
S SDXDIV=""
F S SDXDIV=$O(^TMP(NAMSPC1,$J,SDXDIV)) Q:SDXDIV']""!(SDUP) D
.I SDTL="CLIN" D
..S SDXCLIN=""
..F S SDXCLIN=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXCLIN)) Q:SDXCLIN']""!(SDUP) D
...S SDXNM=""
...F S SDXNM=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXCLIN,SDXNM)) Q:SDXNM']""!(SDUP) I SDXNM]"" D
....S SDXSTOP=0
....F S SDXSTOP=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXCLIN,SDXNM,SDXSTOP)) Q:'SDXSTOP!(SDUP) D
.....S SDATE=0
.....F S SDATE=$O(^TMP("SDNS",$J,SDXDIV,SDXCLIN,SDXNM,SDXSTOP,SDATE)) Q:'SDATE!(SDUP) D
......I $D(^TMP(NAMSPC1,$J,SDXDIV,SDXCLIN,SDXNM,SDXSTOP,SDATE)) D PRT
.I SDTL="STOP" D
..S SDXSTOP=0
..F S SDXSTOP=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXSTOP)) Q:SDXSTOP']""!(SDUP) D
...S SDXNM=""
...F S SDXNM=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXSTOP,SDXNM)) Q:SDXNM']""!(SDUP) I SDXNM]"" D
....S SDXCLIN=""
....F S SDXCLIN=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXSTOP,SDXNM,SDXCLIN)) Q:SDXCLIN']""!(SDUP) D
.....S SDATE=0
.....F S SDATE=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXSTOP,SDXNM,SDXCLIN,SDATE)) Q:SDATE=""!(SDUP) D
......I $D(^TMP(NAMSPC1,$J,SDXDIV,SDXSTOP,SDXNM,SDXCLIN,SDATE)) D PRT
.I SDTL="MEN" D
..S SDXREM=""
..F S SDXREM=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXREM)) Q:SDXREM']""!(SDUP) D
...S SDXNM=""
...F S SDXNM=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXREM,SDXNM)) Q:SDXNM']""!(SDUP) I SDXNM]"" D
....S SDXCLIN=""
....F S SDXCLIN=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXREM,SDXNM,SDXCLIN)) Q:SDXCLIN']""!(SDUP) D
.....S SDATE=0
.....F S SDATE=$O(^TMP(NAMSPC1,$J,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE)) Q:SDATE=""!(SDUP) D
......I $D(^TMP(NAMSPC1,$J,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE)) S SDXSTOP=$P(^TMP(NAMSPC1,$J,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE),"^",6) D PRT
Q
;
;
PRT ;Print report
N SDX
D COUNT^SDMHNS
I '$D(SDXFLG(SDXDIV)) D HEAD^SDMHNS S SDXFLG(SDXDIV)=1,SDXFLG(SDXDIV,SDXCLIN)=1
I $D(SDXFLG(SDXDIV)),'$D(SDXFLG(SDXDIV,SDXCLIN)) S SDX=$$SETSTR("",X,1,80) D SET1(SDX) D HEAD1^SDMHNS S SDXFLG(SDXDIV,SDXCLIN)=1
N SDXNODE,SDXID,SDXDT,SDXSTAT,SDXSORT1,SDXSORT2,SDXCLIEN,SDX,SDDSS
S SDXSORT1=$S(SDTL="MEN":SDXREM,SDTL="STOP":SDXSTOP,1:SDXCLIN)
S SDXSORT2=$S(SDTL="CLIN":SDXSTOP,1:SDXCLIN)
S SDXNODE=$G(^TMP(NAMSPC1,$J,SDXDIV,SDXSORT1,SDXNM,SDXSORT2,SDATE))
S SDXDFN=$P(SDXNODE,"^",1) Q:SDXDFN']""
S SDXID=$P(SDXNODE,"^",4)
S SDXDT=$P(SDXNODE,"^",2)
S SDXSTAT=$P(SDXNODE,"^",3)
S SDXCLIEN=$P(SDXNODE,"^",5)
S SDDSS=$P($G(^DIC(40.7,+$P(SDXNODE,"^",6),0)),"^",2)
I '$D(SDXFLG(SDXDIV,SDXCLIN)) D HEAD1^SDMHNS S SDXFLG(SDXDIV,SDXCLIN)=1
S SDXDT=$$FMTE^XLFDT(SDXDT,"5")
D SET
;S SDX=$$SETSTR(SDCOUNT,X,1,2)_$$SETSTR($P(^DPT(SDXDFN,0),"^",1),X,4,20)_$$SETSTR(SDXID,X,2,4)_$$SETSTR(SDXDT,X,6,20)_$$SETSTR(SDXCLIN,X,2,15)_$$SETSTR("*"_SDXSTAT,X,2,4) D SET1(SDX) I SDCOUNT=$P($G(TOTAL(SDXDIV,SDXCLIN)),"^",1) S SDCOUNT=0
N SDPROV S SDPROV=""
S SDX=$$SETSTR(SDCOUNT,X,1,3)_$$SETSTR($P(^DPT(SDXDFN,0),"^",1),X,3,20)_$$SETSTR(SDXID,X,2,5)_$$SETSTR(SDXDT,X,2,16)_$$SETSTR(SDXCLIN,X,2,30) D SET1(SDX) D PROV D
.S SDX=$$SETSTR("*"_SDXSTAT,X,49,5)_$$SETSTR(SDPROV,X,1,26) D SET1(SDX) I SDCOUNT=$P($G(TOTAL(SDXDIV,SDXCLIN)),"^",1) S SDCOUNT=0
;D PATINFO
;D NOK
;D EC
;D PROV
;D MHTC
D FUT
;D RESULTS
Q
;
;
SETSTR(W,X,Y,Z) ;SET UP THE STRING
;W= String
;X= Variable to set it into
;Y= column to set it into
;Z= length of the strubg
S X=$$SETSTR^SDUL1(W,X,Y,Z)
Q X
SET1(X) ;Sets the XMTEXT global
S SDLN=SDLN+1,^TMP("SDNS1",$J,SDLN,0)=X Q
SET ;
S X="" S SDLN=SDLN+1,^TMP("SDNS1",$J,SDLN,0)=X
Q
;
PATINFO ;Patients home, cell and office phones
N SDPHON,SDX,VAROOT,SDEC6,SDEC5
S DFN=SDXDFN,VAROOT="SDEC6" D ADD^VADPT
I $D(SDEC6) D
. S SDPHON("HOME")=SDEC6(8)
S DFN=SDXDFN,VAOA("A")=5,VAROOT="SDEC5" D OAD^VADPT
I $D(SDEC5) D
. S SDPHON("WORK")=SDEC5(8)
D GETS^DIQ(2,SDXDFN_",",".134","E","SDPHON")
I $D(SDPHON(2,SDXDFN_",")) D
.S SDPHON("CELL")=$G(SDPHON(2,SDXDFN_",",".134","E"))
I $D(SDPHON("HOME")),SDPHON("HOME")]"" S SDX=$$SETSTR("Home: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("HOME"),,) D SET1(SDX)
I $D(SDPHON("WORK")),SDPHON("WORK")]"" S SDX=$$SETSTR("Work: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("WORK"),,) D SET1(SDX)
I $D(SDPHON("CELL")),SDPHON("CELL")]"" S SDX=$$SETSTR("Cell: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("CELL"),,) D SET1(SDX)
Q
;
;
NOK ; Next of Kin information
N SDNOK,SDNOK2,SDNOKNM,SDNOKNM2,SDNOKR,SDNOKR2,SDNOKPH,SDNOKPH2,SDNOKPO,SDNOKPO2,SDNOKFL,SDX,SDSET,VAOA,VAROOT,SDEC3,SDEC4,X,SDPHON
S DFN=SDXDFN,VAROOT="SDEC3" D OAD^VADPT
S DFN=SDXDFN,VAOA("A")=3,VAROOT="SDEC4" D OAD^VADPT
D GETS^DIQ(2,SDXDFN_",",".21011;.211011","E","SDPHON")
I $D(SDPHON(2,SDXDFN_",")) D
.S SDPHON("K-WORK")=$G(SDPHON(2,SDXDFN_",",".21011","E"))
.S SDPHON("K2-WORK")=$G(SDPHON(2,SDXDFN_",",".211011","E"))
S SDNOKFL=0
I $D(SDEC3) D
.S SDNOKNM=SDEC3(9),SDNOKR=SDEC3(10),SDNOKPH=SDEC3(8),SDNOKPO=SDPHON("K-WORK")
I $D(SDEC4) D
.S SDNOKNM2=SDEC4(9),SDNOKR2=SDEC4(10),SDNOKPH2=SDEC3(8),SDNOKPO2=SDPHON("K2-WORK")
S X="",SDX="",SDSET=0
I $D(SDNOKNM),SDNOKNM]"" D:'SDNOKFL NOKFL S SDX=$$SETSTR("NOK: "_SDNOKNM,X,6,20) S SDSET=1
I $D(SDNOKNM2),SDNOKNM2]"" D:'SDNOKFL NOKFL S SDX=SDX_$$SETSTR("NOK2: "_SDNOKNM2,X,20,20) S SDSET=1
I SDSET D SET1(SDX)
S X="",SDX="",SDSET=0
I $D(SDNOKR),SDNOKR]"" D:'SDNOKFL NOKFL S SDX=$$SETSTR("Relation: "_SDNOKR,X,6,20) S SDSET=1
I $D(SDNOKR2),SDNOKR2]"" D:'SDNOKFL NOKFL S SDX=SDX_$$SETSTR("Relation: "_SDNOKR2,X,20,20) S SDSET=1
I SDSET D SET1(SDX)
S X="",SDX="",SDSET=0
I $D(SDNOKPH),SDNOKPH]"" D:'SDNOKFL NOKFL S SDX=$$SETSTR(" Phone: ",X,6,12)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPH,,),X,1,15) S SDSET=1
I $D(SDNOKPH2),SDNOKPH2]"" D:'SDNOKFL NOKFL S SDX=SDX_$$SETSTR(" Phone: ",X,13,12)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPH2,,),X,1,15) S SDSET=1
I SDSET D SET1(SDX)
S X="",SDX="",SDSET=0
I $D(SDNOKPO),SDNOKPO]"" D:'SDNOKFL NOKFL S SDX=$$SETSTR("Office Phone: ",X,6,14)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPO,,),X,1,13) S SDSET=1
I $D(SDNOKPO2),SDNOKPO2]"" D:'SDNOKFL NOKFL S SDX=SDX_$$SETSTR("Office Phone: ",X,13,14)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPO2,,),X,1,15) S SDSET=1
I SDSET D SET1(SDX)
Q
;
;
NOKFL S SDX=$$SETSTR(" Next of Kin: ",X,1,16) D SET1(SDX) S SDNOKFL=1,SDX=""
Q
;
;
EC ;display emergency contact information
N SDEC1,SDEC2,SDX,DFN,X,SDPHON,VAROOT,VAOA
Q:'$G(SDXDFN)
S DFN=SDXDFN
S VAOA("A")=1,VAROOT="SDEC1" D OAD^VADPT ; Get Primary EC
S VAOA("A")=4,VAROOT="SDEC2" D OAD^VADPT ; Get Secondary EC
D GETS^DIQ(2,SDXDFN_",",".33011;.331011","E","SDPHON")
I $D(SDPHON(2,SDXDFN_",")) D
.S SDPHON("E-WORK")=$G(SDPHON(2,SDXDFN_",",".33011","E"))
.S SDPHON("E2-WORK")=$G(SDPHON(2,SDXDFN_",",".331011","E"))
I SDEC1(9)]"" D
.S X=""
. I $D(SDEC1)!($D(SDEC2)) S SDX=$$SETSTR(" Emergency Contact: ",X,1,50) D SET1(SDX)
. ;Contacts name and realtionship
. S SDX=""
. I SDEC1(9)]"" S SDX=$$SETSTR("E-Cont.: ",X,6,10)_$E(SDEC1(9),1,20)
. I SDEC2(9)]"" S SDX=SDX_$$SETSTR("E2-Cont.: ",X,20,10)_$E(SDEC2(9),1,20)
. I SDX]"" D SET1(SDX)
. S SDX=""
. I SDEC1(10)]"" S SDX=$$SETSTR("Relation: ",X,6,10)_SDEC1(10)
. I SDEC2(10)]"" S SDX=SDX_$$SETSTR("Relation: ",X,25,10)_SDEC2(10)
. I SDX]"" D SET1(SDX)
. ;ECs address lines 1, 2 and 3
. S SDX=""
. I SDEC1(1)]"" S SDX=$$SETSTR(SDEC1(1),X,15,20)
. I SDEC2(1)]"" S SDX=SDX_$$SETSTR(SDEC2(1),X,20,20)
. I SDX]"" D SET1(SDX)
. S SDX=""
. I SDEC1(2)]"" S SDX=$$SETSTR(SDEC1(2),X,15,20)
. I SDEC2(2)]"" S SDX=SDX_$$SETSTR(SDEC2(2),X,20,20)
. I SDX]"" D SET1(SDX)
. S SDX=""
. I SDEC1(3)]"" S SDX=$$SETSTR(SDEC1(3),X,15,20)
. I SDEC2(3)]"" S SDX=SDX_$$SETSTR(SDEC2(3),X,20,20)
. I SDX]"" D SET1(SDX)
. S SDX=""
. ;Emergency Contact 1 City, State an Zip+4
. I SDEC1(4)]"" D
. . S SDX=""
. . N SDZ
. . S SDZ=$L(SDEC1(4))
. . S SDX=$$SETSTR(SDEC1(4),X,15,SDZ)
. . I SDEC1(5)]"" S SDX=SDX_", "_$$GET1^DIQ(5,+SDEC1(5),1)
. . S SDX=SDX_" "_$P(SDEC1(11),"^",2)
. ;Emergency Contact 2 City State and Zip+4
. I SDEC2(4)]"" D
. . S SDZ=$L(SDEC2(4))
. . S SDX=SDX_$$SETSTR(SDEC2(4),X,23,SDZ)
. . I SDEC2(5)]"" S SDX=SDX_", "_$$GET1^DIQ(5,+SDEC2(5),1)
. . S SDX=SDX_" "_$P(SDEC2(11),"^",2)
. I SDX]"" D SET1(SDX)
. ;Home and work phones
. S SDX=""
. I SDEC1(8)]"" S SDX=$$SETSTR("Phone: ",X,6,8)_$$HLPHONE^HLFNC(SDEC1(8),,)
. I SDEC2(8)]"" S SDX=SDX_$$SETSTR("Phone: ",X,20,8)_$$HLPHONE^HLFNC(SDEC2(8),,)
. I SDX]"" D SET1(SDX)
. S SDX=""
. I SDPHON("E-WORK")]"" S SDX=$$SETSTR("Work Phone: ",X,6,11)_$$HLPHONE^HLFNC(SDPHON("E-WORK"),,)
. I SDPHON("E2-WORK")]"" S SDX=SDX_$$SETSTR("Work Phone: ",X,17,12)_$$HLPHONE^HLFNC(SDPHON("E2-WORK"),,)
.I SDX]"" D SET1(SDX)
D KVAR^VADPT
Q
;
;
PROV ;Clinic Default Provider
N SDPNUM,SDPNODE,SDX
S SDPNUM=0
F SDPNUM=0:0 S SDPNUM=$O(^SC(SDXCLIEN,"PR",SDPNUM)) Q:'(+SDPNUM) I $D(^SC(SDXCLIEN,"PR",SDPNUM,0)) S SDPNODE=^SC(SDXCLIEN,"PR",SDPNUM,0) I $P(SDPNODE,"^",1)&($P(SDPNODE,"^",2)) D Q:SDUP
.S SDPROV=$P(^VA(200,$P(SDPNODE,"^",1),0),"^",1)
Q
;
;
MHTC ;Mental Health Treatment Coordinator
S SDX=""
S SDX=$$SETSTR("MHTC: ",X,4,11)
D SET1(SDX)
Q
;
;
FUT ; FUTURE SCHEDULED APPTS.
N SDARRAY,SDCOUNT,SDX,X1,X2,X,SDNOSDAY
;S SDNOSDAY=$$GET^XPAR("PKG.SCHEDULING","SDMH NO SHOW DAYS",1,"E")
S SDNOSDAY=$$GET^XPAR("SYS^PKG.SCHEDULING","SDMH NO SHOW DAYS",1,"Q")
S SDNOSDAY=$S(SDNOSDAY]"":SDNOSDAY,1:30)
;Find Scheduled apointments witin 30 days using scheduling API
S X1=DT,X2=SDNOSDAY D C^%DTC S SDX=X
S SDARRAY(1)=DT_";"_SDX
S SDARRAY("SORT")="P"
S SDARRAY(3)="NT;R"
S SDARRAY(4)=SDXDFN
S SDARRAY("FLDS")="1;2;3;4;10;13"
S SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
I SDCOUNT>0 D Q:SDUP
.;Get info on future scheduled appointments and display it
. S SDX="",X=""
. S SDX=$$SETSTR(" Future Scheduled Appointments: ",X,1,40) D SET1(SDX)
. N SDFA,SDFNODE,SDFUTDT ;,SDFUTCNT
. ;S SDFUTCNT=0 ;List up to 6 future appts for one patient
. S SDFA=0 F S SDFA=$O(^TMP($J,"SDAMA301",SDXDFN,SDFA)) Q:SDFA="" D
..S (SDX,X)=""
..S SDFUTDT=$$FMTE^XLFDT(SDFA,"5") S SDFNODE=^TMP($J,"SDAMA301",SDXDFN,SDFA)
..S SDX=$$SETSTR(SDFUTDT,X,12,18)_$$SETSTR($P($P(SDFNODE,"^",2),";",2),X,2,30)
..D SET1(SDX)
.Q
I SDCOUNT'>0 D
.S (SDX,X)=""
.S SDX=" Future Scheduled Appointments: NO APPOINTMENTS SCHEDULED WITHIN "_SDNOSDAY_$S(SDNOSDAY=1:" DAY",1:" DAYS")
.S SDX=$$SETSTR(SDX,X,1,80) D SET1(SDX)
;.S SDX=$$SETSTR(" Future Scheduled Appointments: NO APPOINTMENTS SCHEDULED WITHIN 30 DAYS",X,1,80) D SET1(SDX)
K ^TMP($J,"SDAMA301")
Q
;
;
RESULTS ;Reminder information
N SDX
S (SDX,X)=""
S SDX=$$SETSTR("Results: ",X,4,9) D SET1(SDX)
Q
;
;
PID(DFN) ; Return PID
; INPUT - DFN
; OUTPUT - PID or 'UNKNOWN'
N VA
D PID^VADPT6
Q $S(VA("BID")]"":VA("BID"),1:"UNKNOWN")
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDMHNS1 11380 printed Dec 13, 2024@02:58:40 Page 2
SDMHNS1 ;MAF/ALB - MENTAL HEALTH NO SHOW REPORT (BGJ CONT.);SEPTEMBER 9, 2010
+1 ;;5.3;Scheduling;**578,588**;Aug13,1993;Build 53
DATA ; Set up the data for the patient
+1 ; piece 1 = dfn
+2 ; piece 2 = Appointment Date and time
+3 ; piece 3 = status N(Noshow) or NA (Noshow with auto rebook)
+4 ; piece 4 = PID last 4 of SSN
+5 ; piece 5 = clinic ien ^SC(
+6 ; piece 6 = stop code ien ^DIC(40.7
+7 ;
+8 ;
EN ;PRINT OF THE ^TMP
+1 NEW SDXDIV,SDXCLIN,SDXDFN,SDXSTOP,SDXREM,SDXNM,SDCOUNT,SDATE
+2 SET (SDXDFN,SDXREM,SDCOUNT)=0
+3 IF $DATA(^TMP(NAMSPC1,$JOB))
DO TOTAL^SDMHNS
+4 SET SDXDIV=""
+5 FOR
SET SDXDIV=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV))
if SDXDIV']""!(SDUP)
QUIT
Begin DoDot:1
+6 IF SDTL="CLIN"
Begin DoDot:2
+7 SET SDXCLIN=""
+8 FOR
SET SDXCLIN=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXCLIN))
if SDXCLIN']""!(SDUP)
QUIT
Begin DoDot:3
+9 SET SDXNM=""
+10 FOR
SET SDXNM=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXCLIN,SDXNM))
if SDXNM']""!(SDUP)
QUIT
IF SDXNM]""
Begin DoDot:4
+11 SET SDXSTOP=0
+12 FOR
SET SDXSTOP=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXCLIN,SDXNM,SDXSTOP))
if 'SDXSTOP!(SDUP)
QUIT
Begin DoDot:5
+13 SET SDATE=0
+14 FOR
SET SDATE=$ORDER(^TMP("SDNS",$JOB,SDXDIV,SDXCLIN,SDXNM,SDXSTOP,SDATE))
if 'SDATE!(SDUP)
QUIT
Begin DoDot:6
+15 IF $DATA(^TMP(NAMSPC1,$JOB,SDXDIV,SDXCLIN,SDXNM,SDXSTOP,SDATE))
DO PRT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+16 IF SDTL="STOP"
Begin DoDot:2
+17 SET SDXSTOP=0
+18 FOR
SET SDXSTOP=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSTOP))
if SDXSTOP']""!(SDUP)
QUIT
Begin DoDot:3
+19 SET SDXNM=""
+20 FOR
SET SDXNM=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSTOP,SDXNM))
if SDXNM']""!(SDUP)
QUIT
IF SDXNM]""
Begin DoDot:4
+21 SET SDXCLIN=""
+22 FOR
SET SDXCLIN=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSTOP,SDXNM,SDXCLIN))
if SDXCLIN']""!(SDUP)
QUIT
Begin DoDot:5
+23 SET SDATE=0
+24 FOR
SET SDATE=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSTOP,SDXNM,SDXCLIN,SDATE))
if SDATE=""!(SDUP)
QUIT
Begin DoDot:6
+25 IF $DATA(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSTOP,SDXNM,SDXCLIN,SDATE))
DO PRT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
+26 IF SDTL="MEN"
Begin DoDot:2
+27 SET SDXREM=""
+28 FOR
SET SDXREM=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM))
if SDXREM']""!(SDUP)
QUIT
Begin DoDot:3
+29 SET SDXNM=""
+30 FOR
SET SDXNM=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM,SDXNM))
if SDXNM']""!(SDUP)
QUIT
IF SDXNM]""
Begin DoDot:4
+31 SET SDXCLIN=""
+32 FOR
SET SDXCLIN=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM,SDXNM,SDXCLIN))
if SDXCLIN']""!(SDUP)
QUIT
Begin DoDot:5
+33 SET SDATE=0
+34 FOR
SET SDATE=$ORDER(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE))
if SDATE=""!(SDUP)
QUIT
Begin DoDot:6
+35 IF $DATA(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE))
SET SDXSTOP=$PIECE(^TMP(NAMSPC1,$JOB,SDXDIV,SDXREM,SDXNM,SDXCLIN,SDATE),"^",6)
DO PRT
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
+38 ;
PRT ;Print report
+1 NEW SDX
+2 DO COUNT^SDMHNS
+3 IF '$DATA(SDXFLG(SDXDIV))
DO HEAD^SDMHNS
SET SDXFLG(SDXDIV)=1
SET SDXFLG(SDXDIV,SDXCLIN)=1
+4 IF $DATA(SDXFLG(SDXDIV))
IF '$DATA(SDXFLG(SDXDIV,SDXCLIN))
SET SDX=$$SETSTR("",X,1,80)
DO SET1(SDX)
DO HEAD1^SDMHNS
SET SDXFLG(SDXDIV,SDXCLIN)=1
+5 NEW SDXNODE,SDXID,SDXDT,SDXSTAT,SDXSORT1,SDXSORT2,SDXCLIEN,SDX,SDDSS
+6 SET SDXSORT1=$SELECT(SDTL="MEN":SDXREM,SDTL="STOP":SDXSTOP,1:SDXCLIN)
+7 SET SDXSORT2=$SELECT(SDTL="CLIN":SDXSTOP,1:SDXCLIN)
+8 SET SDXNODE=$GET(^TMP(NAMSPC1,$JOB,SDXDIV,SDXSORT1,SDXNM,SDXSORT2,SDATE))
+9 SET SDXDFN=$PIECE(SDXNODE,"^",1)
if SDXDFN']""
QUIT
+10 SET SDXID=$PIECE(SDXNODE,"^",4)
+11 SET SDXDT=$PIECE(SDXNODE,"^",2)
+12 SET SDXSTAT=$PIECE(SDXNODE,"^",3)
+13 SET SDXCLIEN=$PIECE(SDXNODE,"^",5)
+14 SET SDDSS=$PIECE($GET(^DIC(40.7,+$PIECE(SDXNODE,"^",6),0)),"^",2)
+15 IF '$DATA(SDXFLG(SDXDIV,SDXCLIN))
DO HEAD1^SDMHNS
SET SDXFLG(SDXDIV,SDXCLIN)=1
+16 SET SDXDT=$$FMTE^XLFDT(SDXDT,"5")
+17 DO SET
+18 ;S SDX=$$SETSTR(SDCOUNT,X,1,2)_$$SETSTR($P(^DPT(SDXDFN,0),"^",1),X,4,20)_$$SETSTR(SDXID,X,2,4)_$$SETSTR(SDXDT,X,6,20)_$$SETSTR(SDXCLIN,X,2,15)_$$SETSTR("*"_SDXSTAT,X,2,4) D SET1(SDX) I SDCOUNT=$P($G(TOTAL(SDXDIV,SDXCLIN)),"^",1) S SDCOUNT=0
+19 NEW SDPROV
SET SDPROV=""
+20 SET SDX=$$SETSTR(SDCOUNT,X,1,3)_$$SETSTR($PIECE(^DPT(SDXDFN,0),"^",1),X,3,20)_$$SETSTR(SDXID,X,2,5)_$$SETSTR(SDXDT,X,2,16)_$$SETSTR(SDXCLIN,X,2,30)
DO SET1(SDX)
DO PROV
Begin DoDot:1
+21 SET SDX=$$SETSTR("*"_SDXSTAT,X,49,5)_$$SETSTR(SDPROV,X,1,26)
DO SET1(SDX)
IF SDCOUNT=$PIECE($GET(TOTAL(SDXDIV,SDXCLIN)),"^",1)
SET SDCOUNT=0
End DoDot:1
+22 ;D PATINFO
+23 ;D NOK
+24 ;D EC
+25 ;D PROV
+26 ;D MHTC
+27 DO FUT
+28 ;D RESULTS
+29 QUIT
+30 ;
+31 ;
SETSTR(W,X,Y,Z) ;SET UP THE STRING
+1 ;W= String
+2 ;X= Variable to set it into
+3 ;Y= column to set it into
+4 ;Z= length of the strubg
+5 SET X=$$SETSTR^SDUL1(W,X,Y,Z)
+6 QUIT X
SET1(X) ;Sets the XMTEXT global
+1 SET SDLN=SDLN+1
SET ^TMP("SDNS1",$JOB,SDLN,0)=X
QUIT
SET ;
+1 SET X=""
SET SDLN=SDLN+1
SET ^TMP("SDNS1",$JOB,SDLN,0)=X
+2 QUIT
+3 ;
PATINFO ;Patients home, cell and office phones
+1 NEW SDPHON,SDX,VAROOT,SDEC6,SDEC5
+2 SET DFN=SDXDFN
SET VAROOT="SDEC6"
DO ADD^VADPT
+3 IF $DATA(SDEC6)
Begin DoDot:1
+4 SET SDPHON("HOME")=SDEC6(8)
End DoDot:1
+5 SET DFN=SDXDFN
SET VAOA("A")=5
SET VAROOT="SDEC5"
DO OAD^VADPT
+6 IF $DATA(SDEC5)
Begin DoDot:1
+7 SET SDPHON("WORK")=SDEC5(8)
End DoDot:1
+8 DO GETS^DIQ(2,SDXDFN_",",".134","E","SDPHON")
+9 IF $DATA(SDPHON(2,SDXDFN_","))
Begin DoDot:1
+10 SET SDPHON("CELL")=$GET(SDPHON(2,SDXDFN_",",".134","E"))
End DoDot:1
+11 IF $DATA(SDPHON("HOME"))
IF SDPHON("HOME")]""
SET SDX=$$SETSTR("Home: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("HOME"),,)
DO SET1(SDX)
+12 IF $DATA(SDPHON("WORK"))
IF SDPHON("WORK")]""
SET SDX=$$SETSTR("Work: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("WORK"),,)
DO SET1(SDX)
+13 IF $DATA(SDPHON("CELL"))
IF SDPHON("CELL")]""
SET SDX=$$SETSTR("Cell: ",X,4,7)_$$HLPHONE^HLFNC(SDPHON("CELL"),,)
DO SET1(SDX)
+14 QUIT
+15 ;
+16 ;
NOK ; Next of Kin information
+1 NEW SDNOK,SDNOK2,SDNOKNM,SDNOKNM2,SDNOKR,SDNOKR2,SDNOKPH,SDNOKPH2,SDNOKPO,SDNOKPO2,SDNOKFL,SDX,SDSET,VAOA,VAROOT,SDEC3,SDEC4,X,SDPHON
+2 SET DFN=SDXDFN
SET VAROOT="SDEC3"
DO OAD^VADPT
+3 SET DFN=SDXDFN
SET VAOA("A")=3
SET VAROOT="SDEC4"
DO OAD^VADPT
+4 DO GETS^DIQ(2,SDXDFN_",",".21011;.211011","E","SDPHON")
+5 IF $DATA(SDPHON(2,SDXDFN_","))
Begin DoDot:1
+6 SET SDPHON("K-WORK")=$GET(SDPHON(2,SDXDFN_",",".21011","E"))
+7 SET SDPHON("K2-WORK")=$GET(SDPHON(2,SDXDFN_",",".211011","E"))
End DoDot:1
+8 SET SDNOKFL=0
+9 IF $DATA(SDEC3)
Begin DoDot:1
+10 SET SDNOKNM=SDEC3(9)
SET SDNOKR=SDEC3(10)
SET SDNOKPH=SDEC3(8)
SET SDNOKPO=SDPHON("K-WORK")
End DoDot:1
+11 IF $DATA(SDEC4)
Begin DoDot:1
+12 SET SDNOKNM2=SDEC4(9)
SET SDNOKR2=SDEC4(10)
SET SDNOKPH2=SDEC3(8)
SET SDNOKPO2=SDPHON("K2-WORK")
End DoDot:1
+13 SET X=""
SET SDX=""
SET SDSET=0
+14 IF $DATA(SDNOKNM)
IF SDNOKNM]""
if 'SDNOKFL
DO NOKFL
SET SDX=$$SETSTR("NOK: "_SDNOKNM,X,6,20)
SET SDSET=1
+15 IF $DATA(SDNOKNM2)
IF SDNOKNM2]""
if 'SDNOKFL
DO NOKFL
SET SDX=SDX_$$SETSTR("NOK2: "_SDNOKNM2,X,20,20)
SET SDSET=1
+16 IF SDSET
DO SET1(SDX)
+17 SET X=""
SET SDX=""
SET SDSET=0
+18 IF $DATA(SDNOKR)
IF SDNOKR]""
if 'SDNOKFL
DO NOKFL
SET SDX=$$SETSTR("Relation: "_SDNOKR,X,6,20)
SET SDSET=1
+19 IF $DATA(SDNOKR2)
IF SDNOKR2]""
if 'SDNOKFL
DO NOKFL
SET SDX=SDX_$$SETSTR("Relation: "_SDNOKR2,X,20,20)
SET SDSET=1
+20 IF SDSET
DO SET1(SDX)
+21 SET X=""
SET SDX=""
SET SDSET=0
+22 IF $DATA(SDNOKPH)
IF SDNOKPH]""
if 'SDNOKFL
DO NOKFL
SET SDX=$$SETSTR(" Phone: ",X,6,12)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPH,,),X,1,15)
SET SDSET=1
+23 IF $DATA(SDNOKPH2)
IF SDNOKPH2]""
if 'SDNOKFL
DO NOKFL
SET SDX=SDX_$$SETSTR(" Phone: ",X,13,12)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPH2,,),X,1,15)
SET SDSET=1
+24 IF SDSET
DO SET1(SDX)
+25 SET X=""
SET SDX=""
SET SDSET=0
+26 IF $DATA(SDNOKPO)
IF SDNOKPO]""
if 'SDNOKFL
DO NOKFL
SET SDX=$$SETSTR("Office Phone: ",X,6,14)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPO,,),X,1,13)
SET SDSET=1
+27 IF $DATA(SDNOKPO2)
IF SDNOKPO2]""
if 'SDNOKFL
DO NOKFL
SET SDX=SDX_$$SETSTR("Office Phone: ",X,13,14)_$$SETSTR($$HLPHONE^HLFNC(SDNOKPO2,,),X,1,15)
SET SDSET=1
+28 IF SDSET
DO SET1(SDX)
+29 QUIT
+30 ;
+31 ;
NOKFL SET SDX=$$SETSTR(" Next of Kin: ",X,1,16)
DO SET1(SDX)
SET SDNOKFL=1
SET SDX=""
+1 QUIT
+2 ;
+3 ;
EC ;display emergency contact information
+1 NEW SDEC1,SDEC2,SDX,DFN,X,SDPHON,VAROOT,VAOA
+2 if '$GET(SDXDFN)
QUIT
+3 SET DFN=SDXDFN
+4 ; Get Primary EC
SET VAOA("A")=1
SET VAROOT="SDEC1"
DO OAD^VADPT
+5 ; Get Secondary EC
SET VAOA("A")=4
SET VAROOT="SDEC2"
DO OAD^VADPT
+6 DO GETS^DIQ(2,SDXDFN_",",".33011;.331011","E","SDPHON")
+7 IF $DATA(SDPHON(2,SDXDFN_","))
Begin DoDot:1
+8 SET SDPHON("E-WORK")=$GET(SDPHON(2,SDXDFN_",",".33011","E"))
+9 SET SDPHON("E2-WORK")=$GET(SDPHON(2,SDXDFN_",",".331011","E"))
End DoDot:1
+10 IF SDEC1(9)]""
Begin DoDot:1
+11 SET X=""
+12 IF $DATA(SDEC1)!($DATA(SDEC2))
SET SDX=$$SETSTR(" Emergency Contact: ",X,1,50)
DO SET1(SDX)
+13 ;Contacts name and realtionship
+14 SET SDX=""
+15 IF SDEC1(9)]""
SET SDX=$$SETSTR("E-Cont.: ",X,6,10)_$EXTRACT(SDEC1(9),1,20)
+16 IF SDEC2(9)]""
SET SDX=SDX_$$SETSTR("E2-Cont.: ",X,20,10)_$EXTRACT(SDEC2(9),1,20)
+17 IF SDX]""
DO SET1(SDX)
+18 SET SDX=""
+19 IF SDEC1(10)]""
SET SDX=$$SETSTR("Relation: ",X,6,10)_SDEC1(10)
+20 IF SDEC2(10)]""
SET SDX=SDX_$$SETSTR("Relation: ",X,25,10)_SDEC2(10)
+21 IF SDX]""
DO SET1(SDX)
+22 ;ECs address lines 1, 2 and 3
+23 SET SDX=""
+24 IF SDEC1(1)]""
SET SDX=$$SETSTR(SDEC1(1),X,15,20)
+25 IF SDEC2(1)]""
SET SDX=SDX_$$SETSTR(SDEC2(1),X,20,20)
+26 IF SDX]""
DO SET1(SDX)
+27 SET SDX=""
+28 IF SDEC1(2)]""
SET SDX=$$SETSTR(SDEC1(2),X,15,20)
+29 IF SDEC2(2)]""
SET SDX=SDX_$$SETSTR(SDEC2(2),X,20,20)
+30 IF SDX]""
DO SET1(SDX)
+31 SET SDX=""
+32 IF SDEC1(3)]""
SET SDX=$$SETSTR(SDEC1(3),X,15,20)
+33 IF SDEC2(3)]""
SET SDX=SDX_$$SETSTR(SDEC2(3),X,20,20)
+34 IF SDX]""
DO SET1(SDX)
+35 SET SDX=""
+36 ;Emergency Contact 1 City, State an Zip+4
+37 IF SDEC1(4)]""
Begin DoDot:2
+38 SET SDX=""
+39 NEW SDZ
+40 SET SDZ=$LENGTH(SDEC1(4))
+41 SET SDX=$$SETSTR(SDEC1(4),X,15,SDZ)
+42 IF SDEC1(5)]""
SET SDX=SDX_", "_$$GET1^DIQ(5,+SDEC1(5),1)
+43 SET SDX=SDX_" "_$PIECE(SDEC1(11),"^",2)
End DoDot:2
+44 ;Emergency Contact 2 City State and Zip+4
+45 IF SDEC2(4)]""
Begin DoDot:2
+46 SET SDZ=$LENGTH(SDEC2(4))
+47 SET SDX=SDX_$$SETSTR(SDEC2(4),X,23,SDZ)
+48 IF SDEC2(5)]""
SET SDX=SDX_", "_$$GET1^DIQ(5,+SDEC2(5),1)
+49 SET SDX=SDX_" "_$PIECE(SDEC2(11),"^",2)
End DoDot:2
+50 IF SDX]""
DO SET1(SDX)
+51 ;Home and work phones
+52 SET SDX=""
+53 IF SDEC1(8)]""
SET SDX=$$SETSTR("Phone: ",X,6,8)_$$HLPHONE^HLFNC(SDEC1(8),,)
+54 IF SDEC2(8)]""
SET SDX=SDX_$$SETSTR("Phone: ",X,20,8)_$$HLPHONE^HLFNC(SDEC2(8),,)
+55 IF SDX]""
DO SET1(SDX)
+56 SET SDX=""
+57 IF SDPHON("E-WORK")]""
SET SDX=$$SETSTR("Work Phone: ",X,6,11)_$$HLPHONE^HLFNC(SDPHON("E-WORK"),,)
+58 IF SDPHON("E2-WORK")]""
SET SDX=SDX_$$SETSTR("Work Phone: ",X,17,12)_$$HLPHONE^HLFNC(SDPHON("E2-WORK"),,)
+59 IF SDX]""
DO SET1(SDX)
End DoDot:1
+60 DO KVAR^VADPT
+61 QUIT
+62 ;
+63 ;
PROV ;Clinic Default Provider
+1 NEW SDPNUM,SDPNODE,SDX
+2 SET SDPNUM=0
+3 FOR SDPNUM=0:0
SET SDPNUM=$ORDER(^SC(SDXCLIEN,"PR",SDPNUM))
if '(+SDPNUM)
QUIT
IF $DATA(^SC(SDXCLIEN,"PR",SDPNUM,0))
SET SDPNODE=^SC(SDXCLIEN,"PR",SDPNUM,0)
IF $PIECE(SDPNODE,"^",1)&($PIECE(SDPNODE,"^",2))
Begin DoDot:1
+4 SET SDPROV=$PIECE(^VA(200,$PIECE(SDPNODE,"^",1),0),"^",1)
End DoDot:1
if SDUP
QUIT
+5 QUIT
+6 ;
+7 ;
MHTC ;Mental Health Treatment Coordinator
+1 SET SDX=""
+2 SET SDX=$$SETSTR("MHTC: ",X,4,11)
+3 DO SET1(SDX)
+4 QUIT
+5 ;
+6 ;
FUT ; FUTURE SCHEDULED APPTS.
+1 NEW SDARRAY,SDCOUNT,SDX,X1,X2,X,SDNOSDAY
+2 ;S SDNOSDAY=$$GET^XPAR("PKG.SCHEDULING","SDMH NO SHOW DAYS",1,"E")
+3 SET SDNOSDAY=$$GET^XPAR("SYS^PKG.SCHEDULING","SDMH NO SHOW DAYS",1,"Q")
+4 SET SDNOSDAY=$SELECT(SDNOSDAY]"":SDNOSDAY,1:30)
+5 ;Find Scheduled apointments witin 30 days using scheduling API
+6 SET X1=DT
SET X2=SDNOSDAY
DO C^%DTC
SET SDX=X
+7 SET SDARRAY(1)=DT_";"_SDX
+8 SET SDARRAY("SORT")="P"
+9 SET SDARRAY(3)="NT;R"
+10 SET SDARRAY(4)=SDXDFN
+11 SET SDARRAY("FLDS")="1;2;3;4;10;13"
+12 SET SDCOUNT=$$SDAPI^SDAMA301(.SDARRAY)
+13 IF SDCOUNT>0
Begin DoDot:1
+14 ;Get info on future scheduled appointments and display it
+15 SET SDX=""
SET X=""
+16 SET SDX=$$SETSTR(" Future Scheduled Appointments: ",X,1,40)
DO SET1(SDX)
+17 ;,SDFUTCNT
NEW SDFA,SDFNODE,SDFUTDT
+18 ;S SDFUTCNT=0 ;List up to 6 future appts for one patient
+19 SET SDFA=0
FOR
SET SDFA=$ORDER(^TMP($JOB,"SDAMA301",SDXDFN,SDFA))
if SDFA=""
QUIT
Begin DoDot:2
+20 SET (SDX,X)=""
+21 SET SDFUTDT=$$FMTE^XLFDT(SDFA,"5")
SET SDFNODE=^TMP($JOB,"SDAMA301",SDXDFN,SDFA)
+22 SET SDX=$$SETSTR(SDFUTDT,X,12,18)_$$SETSTR($PIECE($PIECE(SDFNODE,"^",2),";",2),X,2,30)
+23 DO SET1(SDX)
End DoDot:2
+24 QUIT
End DoDot:1
if SDUP
QUIT
+25 IF SDCOUNT'>0
Begin DoDot:1
+26 SET (SDX,X)=""
+27 SET SDX=" Future Scheduled Appointments: NO APPOINTMENTS SCHEDULED WITHIN "_SDNOSDAY_$SELECT(SDNOSDAY=1:" DAY",1:" DAYS")
+28 SET SDX=$$SETSTR(SDX,X,1,80)
DO SET1(SDX)
End DoDot:1
+29 ;.S SDX=$$SETSTR(" Future Scheduled Appointments: NO APPOINTMENTS SCHEDULED WITHIN 30 DAYS",X,1,80) D SET1(SDX)
+30 KILL ^TMP($JOB,"SDAMA301")
+31 QUIT
+32 ;
+33 ;
RESULTS ;Reminder information
+1 NEW SDX
+2 SET (SDX,X)=""
+3 SET SDX=$$SETSTR("Results: ",X,4,9)
DO SET1(SDX)
+4 QUIT
+5 ;
+6 ;
PID(DFN) ; Return PID
+1 ; INPUT - DFN
+2 ; OUTPUT - PID or 'UNKNOWN'
+3 NEW VA
+4 DO PID^VADPT6
+5 QUIT $SELECT(VA("BID")]"":VA("BID"),1:"UNKNOWN")
+6 ;
