- 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"