BEHOPTPL ;MSC/IND/DKM - Patient List Management ;15-Sep-2014 22:13;PLS
;;1.1;BEH COMPONENTS;**004004,004010**;Mar 20, 2007
;=================================================================
; Lookup by full or partial SSN
LOOKUP(DATA,ID) ;
N IEN,XREF,CNT,QUALS
S DATA=$$TMPGBL^CIAVMRPC,(CNT,IEN)=0,ID=$$UP^XLFSTR($TR(ID,"-")),XREF=$S(ID?4N:"BS",ID?1A4N:"BS5",1:"SSN")
F S IEN=$O(^DPT(XREF,ID,IEN)) Q:'IEN D
.S:$$ISACTIVE^BEHOPTCX(IEN,.QUALS) CNT=CNT+1,@DATA@(CNT)=IEN_U_$P(^DPT(IEN,0),U)_U_$$SSN(IEN)_" "_$$DOB^DPTLK1(IEN)
Q
; Return list of patients with specified HRN
HRNLKP(DATA,HRN) ;
N CNT,DFN,QUALS
S CNT=0,HRN=$$UP^XLFSTR($TR(HRN,"-"))
S:HRN?1.N HRN=+HRN
F DFN=0:0 S DFN=$O(^AUPNPAT("D",HRN,DFN)) Q:'DFN D:$D(^(DFN,DUZ(2)))
.S:$$ISACTIVE^BEHOPTCX(DFN,.QUALS) CNT=CNT+1,DATA(CNT)=DFN_U_$P(^DPT(DFN,0),U)_U_HRN_" "_$$DOB^DPTLK1(DFN)
Q
; Patient lookup using IEN
IENLKP(DATA,IEN) ;
N DFN
I $E(IEN)="`" D
.S DFN=+$E(IEN,2,$L(IEN))
.S:$$ISACTIVE^BEHOPTCX(DFN) DATA(1)=DFN_U_$P(^DPT(DFN,0),U)_U_$$HRN^BEHOPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
Q
; Patient lookup using DOB
DOBLKP(DATA,DOB) ;
N DFN,%DT,X,Y,CNT,QUALS
S DATA=$$TMPGBL^CIAVMRPC
I $E(DOB)="B" D
.S DOB=$E(DOB,2,$L(DOB)),CNT=0
.S %DT="P",X=DOB D ^%DT
.I Y>0 S DOB=Y D
..S DFN=0 F S DFN=$O(^DPT("ADOB",DOB,DFN)) Q:DFN<1 D
...S:$$ISACTIVE^BEHOPTCX(DFN,.QUALS) CNT=CNT+1,@DATA@(CNT)=DFN_U_$P(^DPT(DFN,0),U)_U_$$HRN^BEHOPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
Q
; Return formatted SSN for patient
SSN(DFN) ;EP-
Q $$FMTSSN^BEHOPTCX($P($G(^DPT(DFN,0)),U,9)) ;P14
; Return a bolus of patient names
LISTALL(DATA,FROM,DIR,MAX) ;
N CNT,IEN,MAX,GBL,QUALS,DEMO
S MAX=$G(MAX,44),CNT=0,DEMO=$$LKPQUAL^BEHOPTCX("@BEHOPTCX DEMO MODE",.QUALS)
I DEMO D
.S IEN=0,GBL=$NA(^TMP("BEHOPTPL",$J))
.K @GBL
.F S IEN=$O(^DPT("ATEST",IEN)) Q:'IEN S @GBL@($E($P(^DPT(IEN,0),U),1,30),IEN)=""
E I '$$LKPQUAL^BEHOPTCX("MSC DG ALL SITES HIPAA",.QUALS),$D(^DPT("ADIV",DUZ(2))) S GBL=$NA(^(DUZ(2)))
E S GBL=$NA(^DPT("B"))
F S FROM=$O(@GBL@(FROM),DIR),IEN=0 Q:FROM="" D Q:CNT'<MAX
.F S IEN=$O(@GBL@(FROM,IEN)) Q:'IEN D
..I 'DEMO,'($D(@GBL@(FROM,IEN))#2),$$LKPQUAL^BEHOPTCX("@BEHOPTCX IGNORE ALIASES",.QUALS) Q
..S:$$ISACTIVE^BEHOPTCX(IEN,.QUALS) CNT=CNT+1,DATA(CNT)=IEN_U_FROM
K:DEMO ^TMP("BEHOPTPL",$J)
Q
; Returns information about a list or lists
; LIST = IEN (19930.4) of list (all lists returned if not specified)
; Returns IEN^NAME^FLAGS^ENTITY^DFLT
; where DFLT is default item settings as
; IEN^NAME^START DATE^END DATE^DATE LABEL
LISTINFO(DATA,LIST) ;
N X,X1,X2,INFO,SEQ,ONE,CNT
S LIST=+$G(LIST),DATA="",CNT=0
I LIST S X1=LIST-1,X2=LIST
E S X1=0,X2=9999999999
F S X1=$O(^BEHOPT(90460.03,X1)) Q:'X1!(X1>X2) S X=^(X1,0) I '$P(X,U,5),$$LISTSCRN(X1) D
.S INFO=X1_U_$P(X,U,1,3),SEQ=+$P(X,U,4)
.S $P(INFO,U,5)=$TR($$GET^XPAR("ALL",$$PARAMITM,"`"_X1),"~",U)
.I LIST S DATA=INFO
.E S CNT=CNT+1,DATA(SEQ*1000+CNT)=INFO
Q
; Screen logic for lists
LISTSCRN(LIST) ;
I 1
D EXEC(13)
Q $T
; Call logic to generate patient list
LISTPTS(DATA,LIST,IEN,FLT) ;
N START,END
D PARSEFLT(.FLT,.START,.END)
D EXEC(10)
Q
; Call logic to generate list selections
LISTSEL(DATA,LIST,FROM,DIR,MAX,FLT) ;
N START,END
D PARSEFLT(.FLT,.START,.END)
D EXEC(11)
Q
; Parse list filter
PARSEFLT(FLT,START,END) ;
S FLT=$P($G(FLT),U),START=$P(FLT,";"),END=$P(FLT,";",2)
D:$L(START) DT^DILF("T",START,.START,"","")
D:$L(END) DT^DILF("T",END,.END,"","")
Q
; Call logic to manage user lists
MANAGE(DATA,LIST,ACTION,NAME,VAL) ;
D EXEC(12)
Q
; Execute logic at specified node
EXEC(NODE) ;
N $ET
S $ET="",@$$TRAP^CIAUOS("EXECERR^BEHOPTPL")
D:'$G(LIST) GETDFLT(.LIST)
X $G(^BEHOPT(90460.03,+LIST,NODE))
Q
EXECERR K DATA
S DATA(1)="-1^Error: "_$$EC^%ZOSV
I 0
Q
; Return default patient list source
GETDFLT(DATA) ;
S DATA=$$GET^XPAR("ALL",$$PARAMSRC)
D:DATA LISTINFO(.DATA,DATA)
Q
; Save new default patient list settings
; LIST = Default list (if missing, default is deleted)
; .VAL = Default settings for lists (optional)
SAVEDFLT(DATA,LIST,VAL) ;
N LP
S LIST=$S($G(LIST)>0:"`"_+LIST,1:"@")
D EN^XPAR("USR",$$PARAMSRC,1,LIST,.DATA)
I 'DATA,$D(VAL) D
.;D NDEL^XPAR("USR",$$PARAMITM)
.F LP=0:0 S LP=$O(VAL(LP)) Q:'LP!DATA D
..S VAL=VAL(LP)
..D:VAL>0 EN^XPAR("USR",$$PARAMITM,"`"_+VAL,$TR($P(VAL,U,5,99),U,"~"),.DATA)
Q
; Return date ranges for clinic appointments
CLINRNG(DATA) ;
D GETWP^XPAR(.DATA,"ALL","BEHOPTPL DATE RANGES")
Q
; Returns parameter name for default source
PARAMSRC() Q "BEHOPTPL DEFAULT SOURCE"
; Returns parameter name for default item
PARAMITM() Q "BEHOPTPL DEFAULT ITEM"
BEHOPTPL ;MSC/IND/DKM - Patient List Management ;15-Sep-2014 22:13;PLS
+1 ;;1.1;BEH COMPONENTS;**004004,004010**;Mar 20, 2007
+2 ;=================================================================
+3 ; Lookup by full or partial SSN
LOOKUP(DATA,ID) ;
+1 NEW IEN,XREF,CNT,QUALS
+2 SET DATA=$$TMPGBL^CIAVMRPC
SET (CNT,IEN)=0
SET ID=$$UP^XLFSTR($TRANSLATE(ID,"-"))
SET XREF=$SELECT(ID?4N:"BS",ID?1A4N:"BS5",1:"SSN")
+3 FOR
SET IEN=$ORDER(^DPT(XREF,ID,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 IF $$ISACTIVE^BEHOPTCX(IEN,.QUALS)
SET CNT=CNT+1
SET @DATA@(CNT)=IEN_U_$PIECE(^DPT(IEN,0),U)_U_$$SSN(IEN)_" "_$$DOB^DPTLK1(IEN)
End DoDot:1
+5 QUIT
+6 ; Return list of patients with specified HRN
HRNLKP(DATA,HRN) ;
+1 NEW CNT,DFN,QUALS
+2 SET CNT=0
SET HRN=$$UP^XLFSTR($TRANSLATE(HRN,"-"))
+3 IF HRN?1.N
SET HRN=+HRN
+4 FOR DFN=0:0
SET DFN=$ORDER(^AUPNPAT("D",HRN,DFN))
IF 'DFN
QUIT
IF $DATA(^(DFN,DUZ(2)))
Begin DoDot:1
+5 IF $$ISACTIVE^BEHOPTCX(DFN,.QUALS)
SET CNT=CNT+1
SET DATA(CNT)=DFN_U_$PIECE(^DPT(DFN,0),U)_U_HRN_" "_$$DOB^DPTLK1(DFN)
End DoDot:1
+6 QUIT
+7 ; Patient lookup using IEN
IENLKP(DATA,IEN) ;
+1 NEW DFN
+2 IF $EXTRACT(IEN)="`"
Begin DoDot:1
+3 SET DFN=+$EXTRACT(IEN,2,$LENGTH(IEN))
+4 IF $$ISACTIVE^BEHOPTCX(DFN)
SET DATA(1)=DFN_U_$PIECE(^DPT(DFN,0),U)_U_$$HRN^BEHOPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
End DoDot:1
+5 QUIT
+6 ; Patient lookup using DOB
DOBLKP(DATA,DOB) ;
+1 NEW DFN,%DT,X,Y,CNT,QUALS
+2 SET DATA=$$TMPGBL^CIAVMRPC
+3 IF $EXTRACT(DOB)="B"
Begin DoDot:1
+4 SET DOB=$EXTRACT(DOB,2,$LENGTH(DOB))
SET CNT=0
+5 SET %DT="P"
SET X=DOB
DO ^%DT
+6 IF Y>0
SET DOB=Y
Begin DoDot:2
+7 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("ADOB",DOB,DFN))
IF DFN<1
QUIT
Begin DoDot:3
+8 IF $$ISACTIVE^BEHOPTCX(DFN,.QUALS)
SET CNT=CNT+1
SET @DATA@(CNT)=DFN_U_$PIECE(^DPT(DFN,0),U)_U_$$HRN^BEHOPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ; Return formatted SSN for patient
SSN(DFN) ;EP-
+1 ;P14
QUIT $$FMTSSN^BEHOPTCX($PIECE($GET(^DPT(DFN,0)),U,9))
+2 ; Return a bolus of patient names
LISTALL(DATA,FROM,DIR,MAX) ;
+1 NEW CNT,IEN,MAX,GBL,QUALS,DEMO
+2 SET MAX=$GET(MAX,44)
SET CNT=0
SET DEMO=$$LKPQUAL^BEHOPTCX("@BEHOPTCX DEMO MODE",.QUALS)
+3 IF DEMO
Begin DoDot:1
+4 SET IEN=0
SET GBL=$NAME(^TMP("BEHOPTPL",$JOB))
+5 KILL @GBL
+6 FOR
SET IEN=$ORDER(^DPT("ATEST",IEN))
IF 'IEN
QUIT
SET @GBL@($EXTRACT($PIECE(^DPT(IEN,0),U),1,30),IEN)=""
End DoDot:1
+7 IF '$TEST
IF '$$LKPQUAL^BEHOPTCX("MSC DG ALL SITES HIPAA",.QUALS)
IF $DATA(^DPT("ADIV",DUZ(2)))
SET GBL=$NAME(^(DUZ(2)))
+8 IF '$TEST
SET GBL=$NAME(^DPT("B"))
+9 FOR
SET FROM=$ORDER(@GBL@(FROM),DIR)
SET IEN=0
IF FROM=""
QUIT
Begin DoDot:1
+10 FOR
SET IEN=$ORDER(@GBL@(FROM,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+11 IF 'DEMO
IF '($DATA(@GBL@(FROM,IEN))#2)
IF $$LKPQUAL^BEHOPTCX("@BEHOPTCX IGNORE ALIASES",.QUALS)
QUIT
+12 IF $$ISACTIVE^BEHOPTCX(IEN,.QUALS)
SET CNT=CNT+1
SET DATA(CNT)=IEN_U_FROM
End DoDot:2
End DoDot:1
IF CNT'<MAX
QUIT
+13 IF DEMO
KILL ^TMP("BEHOPTPL",$JOB)
+14 QUIT
+15 ; Returns information about a list or lists
+16 ; LIST = IEN (19930.4) of list (all lists returned if not specified)
+17 ; Returns IEN^NAME^FLAGS^ENTITY^DFLT
+18 ; where DFLT is default item settings as
+19 ; IEN^NAME^START DATE^END DATE^DATE LABEL
LISTINFO(DATA,LIST) ;
+1 NEW X,X1,X2,INFO,SEQ,ONE,CNT
+2 SET LIST=+$GET(LIST)
SET DATA=""
SET CNT=0
+3 IF LIST
SET X1=LIST-1
SET X2=LIST
+4 IF '$TEST
SET X1=0
SET X2=9999999999
+5 FOR
SET X1=$ORDER(^BEHOPT(90460.03,X1))
IF 'X1!(X1>X2)
QUIT
SET X=^(X1,0)
IF '$PIECE(X,U,5)
IF $$LISTSCRN(X1)
Begin DoDot:1
+6 SET INFO=X1_U_$PIECE(X,U,1,3)
SET SEQ=+$PIECE(X,U,4)
+7 SET $PIECE(INFO,U,5)=$TRANSLATE($$GET^XPAR("ALL",$$PARAMITM,"`"_X1),"~",U)
+8 IF LIST
SET DATA=INFO
+9 IF '$TEST
SET CNT=CNT+1
SET DATA(SEQ*1000+CNT)=INFO
End DoDot:1
+10 QUIT
+11 ; Screen logic for lists
LISTSCRN(LIST) ;
+1 IF 1
+2 DO EXEC(13)
+3 QUIT $TEST
+4 ; Call logic to generate patient list
LISTPTS(DATA,LIST,IEN,FLT) ;
+1 NEW START,END
+2 DO PARSEFLT(.FLT,.START,.END)
+3 DO EXEC(10)
+4 QUIT
+5 ; Call logic to generate list selections
LISTSEL(DATA,LIST,FROM,DIR,MAX,FLT) ;
+1 NEW START,END
+2 DO PARSEFLT(.FLT,.START,.END)
+3 DO EXEC(11)
+4 QUIT
+5 ; Parse list filter
PARSEFLT(FLT,START,END) ;
+1 SET FLT=$PIECE($GET(FLT),U)
SET START=$PIECE(FLT,";")
SET END=$PIECE(FLT,";",2)
+2 IF $LENGTH(START)
DO DT^DILF("T",START,.START,"","")
+3 IF $LENGTH(END)
DO DT^DILF("T",END,.END,"","")
+4 QUIT
+5 ; Call logic to manage user lists
MANAGE(DATA,LIST,ACTION,NAME,VAL) ;
+1 DO EXEC(12)
+2 QUIT
+3 ; Execute logic at specified node
EXEC(NODE) ;
+1 NEW $ETRAP
+2 SET $ETRAP=""
SET @$$TRAP^CIAUOS("EXECERR^BEHOPTPL")
+3 IF '$GET(LIST)
DO GETDFLT(.LIST)
+4 XECUTE $GET(^BEHOPT(90460.03,+LIST,NODE))
+5 QUIT
EXECERR KILL DATA
+1 SET DATA(1)="-1^Error: "_$$EC^%ZOSV
+2 IF 0
+3 QUIT
+4 ; Return default patient list source
GETDFLT(DATA) ;
+1 SET DATA=$$GET^XPAR("ALL",$$PARAMSRC)
+2 IF DATA
DO LISTINFO(.DATA,DATA)
+3 QUIT
+4 ; Save new default patient list settings
+5 ; LIST = Default list (if missing, default is deleted)
+6 ; .VAL = Default settings for lists (optional)
SAVEDFLT(DATA,LIST,VAL) ;
+1 NEW LP
+2 SET LIST=$SELECT($GET(LIST)>0:"`"_+LIST,1:"@")
+3 DO EN^XPAR("USR",$$PARAMSRC,1,LIST,.DATA)
+4 IF 'DATA
IF $DATA(VAL)
Begin DoDot:1
+5 ;D NDEL^XPAR("USR",$$PARAMITM)
+6 FOR LP=0:0
SET LP=$ORDER(VAL(LP))
IF 'LP!DATA
QUIT
Begin DoDot:2
+7 SET VAL=VAL(LP)
+8 IF VAL>0
DO EN^XPAR("USR",$$PARAMITM,"`"_+VAL,$TRANSLATE($PIECE(VAL,U,5,99),U,"~"),.DATA)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ; Return date ranges for clinic appointments
CLINRNG(DATA) ;
+1 DO GETWP^XPAR(.DATA,"ALL","BEHOPTPL DATE RANGES")
+2 QUIT
+3 ; Returns parameter name for default source
PARAMSRC() QUIT "BEHOPTPL DEFAULT SOURCE"
+1 ; Returns parameter name for default item
PARAMITM() QUIT "BEHOPTPL DEFAULT ITEM"
