SDECPTPL.m

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 ---SDECPTPL   3920     printed  Mar 13, 2025@21:57:27                                                                                                                                                                                                    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"