SDECPTPL ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
;=================================================================
; 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,QUALS=""
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 '($D(@GBL@(FROM,IEN))#2) Q
..S:$$ISACTIVE^SDECPTCX(IEN,.QUALS) CNT=CNT+1,DATA(CNT)=IEN_U_FROM
Q
;
; Lookup by full or partial SSN
LOOKUP(DATA,ID) ;
N IEN,XREF,CNT,QUALS
S DATA=^TMP("SDECPTPL",$J),(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^SDECPTCX(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^SDECPTCX(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^SDECPTCX(DFN) DATA(1)=DFN_U_$P(^DPT(DFN,0),U)_U_$$HRN^SDECPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
Q
; Patient lookup using DOB
DOBLKP(DATA,DOB) ;
N DFN,%DT,X,Y,CNT,QUALS
S DATA=^TMP("SDECPTPL",$J)
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^SDECPTCX(DFN,.QUALS) CNT=CNT+1,@DATA@(CNT)=DFN_U_$P(^DPT(DFN,0),U)_U_$$HRN^SDECPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
Q
; Return formatted SSN for patient
SSN(DFN) N SSN
S SSN=$$SSN^DPTLK1(DFN)
Q $S(SSN?9N.1"P":$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,10),1:"")
; 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) ;
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) ;
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"
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECPTPL 3920 printed Sep 23, 2025@20:28:52 Page 2
SDECPTPL ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
+5 ;=================================================================
+6 ; 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 QUALS=""
+3 SET GBL=$NAME(^DPT("B"))
+4 FOR
SET FROM=$ORDER(@GBL@(FROM),DIR)
SET IEN=0
if FROM=""
QUIT
Begin DoDot:1
+5 FOR
SET IEN=$ORDER(@GBL@(FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+6 IF '($DATA(@GBL@(FROM,IEN))#2)
QUIT
+7 if $$ISACTIVE^SDECPTCX(IEN,.QUALS)
SET CNT=CNT+1
SET DATA(CNT)=IEN_U_FROM
End DoDot:2
End DoDot:1
if CNT'<MAX
QUIT
+8 QUIT
+9 ;
+10 ; Lookup by full or partial SSN
LOOKUP(DATA,ID) ;
+1 NEW IEN,XREF,CNT,QUALS
+2 SET DATA=^TMP("SDECPTPL",$JOB)
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^SDECPTCX(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^SDECPTCX(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^SDECPTCX(DFN)
SET DATA(1)=DFN_U_$PIECE(^DPT(DFN,0),U)_U_$$HRN^SDECPTCX(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=^TMP("SDECPTPL",$JOB)
+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^SDECPTCX(DFN,.QUALS)
SET CNT=CNT+1
SET @DATA@(CNT)=DFN_U_$PIECE(^DPT(DFN,0),U)_U_$$HRN^SDECPTCX(DFN)_" "_$$DOB^DPTLK1(DFN)
End DoDot:3
End DoDot:2
End DoDot:1
+9 QUIT
+10 ; Return formatted SSN for patient
SSN(DFN) NEW SSN
+1 SET SSN=$$SSN^DPTLK1(DFN)
+2 QUIT $SELECT(SSN?9N.1"P":$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,10),1:"")
+3 ; Returns information about a list or lists
+4 ; LIST = IEN (19930.4) of list (all lists returned if not specified)
+5 ; Returns IEN^NAME^FLAGS^ENTITY^DFLT
+6 ; where DFLT is default item settings as
+7 ; IEN^NAME^START DATE^END DATE^DATE LABEL
LISTINFO(DATA,LIST) ;
+1 QUIT
+2 ; 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 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"
