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

BEHOPTPL.m

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