DGQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;12/15/97
;;5.3;Registration;**447**;Aug 13, 1993
;
; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
;
DEFSRC(Y) ; return current user's default list source
Q:'$D(DUZ)
N FROM,API,DGSRV
S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
S FROM=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
Q:'$L($G(FROM))
I FROM="T" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
I FROM="W" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
I FROM="P" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
I FROM="S" S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
I FROM="C" D
.S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
.S Y=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
; Next line added by PKS:
I FROM="M" S Y="^Combination"
Q
FDEFSRC(DGDUZ) ; extrinsic function return user's (DGDUZ) default list source
Q:'$D(DGDUZ) "^^Error: No user identified"
N FROM,API,RESULT,DGSRV
S DGSRV=$G(^VA(200,DGDUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
S FROM=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
Q:'$L($G(FROM)) "^^No default list source specified"
I FROM="T" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
I FROM="W" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
I FROM="P" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
I FROM="S" S RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$G(ORSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
I FROM="C" D
.S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
.S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
; Next line added by PKS - 3/2000:
I FROM="M" S RESULT="^Combination"
Q RESULT
LISTSRC(DGDUZ,TYPE) ; extrinsic function return user's (DGDUZ) list source
; for list type team, ward, primary provider, specialty, clinic, combination (TYPE)
Q:'$D(DGDUZ) "^^Error: No user identified"
Q:'$D(TYPE) "^^Error: No list type identified"
N API,RESULT,DGSRV
S DGSRV=$G(^VA(200,DGDUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
I TYPE="T" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
I TYPE="W" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
I TYPE="P" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
I TYPE="S" S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
I TYPE="C" D
.S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
.S RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$G(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
; Next line added by PKS:
I TYPE="M" S RESULT="Combination"
I $P(RESULT,U)="" S RESULT=U_RESULT
Q RESULT
DEFLIST(Y) ; return current user's default patient list
I $$BROKER^XWBLIB S Y=$NA(^TMP("DG",$J,"PATIENTS")) ; GUI = global.
I '$$BROKER^XWBLIB S ^TMP("DG",$J,"PATIENTS",0)=""
Q:'$D(DUZ)
N FROM,IEN,BEG,END,API,DGSRV,DGQDAT,DGQCNT,DGGUI
S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U) ; Get S/S.
S FROM=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
Q:'$L($G(FROM))
I FROM="T" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT TEAM",1,"Q") D:+$G(IEN)>0 TEAMPTS^DGQPTQ1(.Y,IEN)
I FROM="W" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT WARD",1,"Q") D:+$G(IEN)>0 WARDPTS^DGQPTQ2(.Y,IEN)
I FROM="P" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT PROVIDER",1,"Q") D:+$G(IEN)>0 PROVPTS^DGQPTQ2(.Y,IEN)
I FROM="S" S IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),"DGLP DEFAULT SPECIALTY",1,"Q") D:+$G(IEN)>0 SPECPTS^DGQPTQ2(.Y,IEN)
I FROM="C" D
.S API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT)),IEN=$$GET^XPAR("USR^SRV.`"_+$G(DGSRV),API,1,"Q") I +$G(IEN)>0 D
..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
..D CLINPTS^DGQPTQ2(.Y,+$G(IEN),BEG,END)
; Next section added by PKS:
I FROM="M" D
.S IEN=$D(^OR(100.24,DUZ,0)) I +$G(IEN)>0 S IEN=DUZ D
..S BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
..I BEG="T+0" S BEG=$$FMTE^XLFDT(DT,BEG)
..S END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$G(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
..I END="T+0" S END=$$FMTE^XLFDT(DT,END)
..D COMBPTS^DGQPTQ6(0,+$G(IEN),BEG,END) ; "0"= GUI RPC call.
; Added by PKS - 3/2001, to write to global for GUI:
I ($$BROKER^XWBLIB)&(FROM'="M") D ; Combinations already written to global.
.; Put list into a global:
.S DGQDAT="",DGQCNT=1
.F S DGQDAT=$G(Y(DGQCNT)) Q:DGQDAT="" D
..S ^TMP("DG",$J,"PATIENTS",DGQCNT,0)=DGQDAT
..S DGQCNT=DGQCNT+1
I ('$$BROKER^XWBLIB) S Y=FROM_";"_+$G(IEN)_";"_$G(BEG)_";"_$G(END) ; MKB 10/13/95
Q
DEFSORT(Y) ; Return user's default "sort" for patient selection lists.
; SLC/PKS - 4/6/2001
;
N DGSORT,DGSECT,DGPARAM
;
I ('$D(DUZ)) S Y="Unable to determine DUZ." Q
;
; Get user's current service/section:
S DGSECT=$G(^VA(200,DUZ,5))
I +DGSECT>0 S DGSECT=$P(DGSECT,U)
;
; Retrieve current sort parameter:
S Y="A" ; Default of "Alpha" sort.
S DGPARAM="DGLP DEFAULT LIST ORDER"
S DGSORT=$$GET^XPAR("USR^SRV.`"_$G(DGSECT)_"^DIV^SYS^PKG",DGPARAM,1,"I")
I (DGSORT'="") S Y=DGSORT
;
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGQPTQ11 5901 printed Dec 13, 2024@02:54:41 Page 2
DGQPTQ11 ; SLC/CLA - Functs which return patient lists and sources pt 1B ;12/15/97
+1 ;;5.3;Registration;**447**;Aug 13, 1993
+2 ;
+3 ; SLC/PKS - Modified to deal with "Combination" lists - 3/2000.
+4 ;
DEFSRC(Y) ; return current user's default list source
+1 if '$DATA(DUZ)
QUIT
+2 NEW FROM,API,DGSRV
+3 SET DGSRV=$GET(^VA(200,DUZ,5))
IF +DGSRV>0
SET DGSRV=$PIECE(DGSRV,U)
+4 SET FROM=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
+5 if '$LENGTH($GET(FROM))
QUIT
+6 IF FROM="T"
SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
+7 IF FROM="W"
SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
+8 IF FROM="P"
SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
+9 IF FROM="S"
SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
+10 IF FROM="C"
Begin DoDot:1
+11 SET API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
+12 SET Y=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
End DoDot:1
+13 ; Next line added by PKS:
+14 IF FROM="M"
SET Y="^Combination"
+15 QUIT
FDEFSRC(DGDUZ) ; extrinsic function return user's (DGDUZ) default list source
+1 if '$DATA(DGDUZ)
QUIT "^^Error: No user identified"
+2 NEW FROM,API,RESULT,DGSRV
+3 SET DGSRV=$GET(^VA(200,DGDUZ,5))
IF +DGSRV>0
SET DGSRV=$PIECE(DGSRV,U)
+4 SET FROM=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
+5 if '$LENGTH($GET(FROM))
QUIT "^^No default list source specified"
+6 IF FROM="T"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
+7 IF FROM="W"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
+8 IF FROM="P"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
+9 IF FROM="S"
SET RESULT=$$GET^XPAR("USR.`"_ORDUZ_"^SRV.`"_+$GET(ORSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
+10 IF FROM="C"
Begin DoDot:1
+11 SET API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
+12 SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
End DoDot:1
+13 ; Next line added by PKS - 3/2000:
+14 IF FROM="M"
SET RESULT="^Combination"
+15 QUIT RESULT
LISTSRC(DGDUZ,TYPE) ; extrinsic function return user's (DGDUZ) list source
+1 ; for list type team, ward, primary provider, specialty, clinic, combination (TYPE)
+2 if '$DATA(DGDUZ)
QUIT "^^Error: No user identified"
+3 if '$DATA(TYPE)
QUIT "^^Error: No list type identified"
+4 NEW API,RESULT,DGSRV
+5 SET DGSRV=$GET(^VA(200,DGDUZ,5))
IF +DGSRV>0
SET DGSRV=$PIECE(DGSRV,U)
+6 IF TYPE="T"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT TEAM",1,"B")_"^Team"
+7 IF TYPE="W"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT WARD",1,"B")_"^Ward"
+8 IF TYPE="P"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT PROVIDER",1,"B")_"^Primary Provider"
+9 IF TYPE="S"
SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT SPECIALTY",1,"B")_"^Specialty"
+10 IF TYPE="C"
Begin DoDot:1
+11 SET API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
+12 SET RESULT=$$GET^XPAR("USR.`"_DGDUZ_"^SRV.`"_+$GET(DGSRV),API,1,"B")_"^"_$$DOW^XLFDT(DT)_" Clinic"
End DoDot:1
+13 ; Next line added by PKS:
+14 IF TYPE="M"
SET RESULT="Combination"
+15 IF $PIECE(RESULT,U)=""
SET RESULT=U_RESULT
+16 QUIT RESULT
DEFLIST(Y) ; return current user's default patient list
+1 ; GUI = global.
IF $$BROKER^XWBLIB
SET Y=$NAME(^TMP("DG",$JOB,"PATIENTS"))
+2 IF '$$BROKER^XWBLIB
SET ^TMP("DG",$JOB,"PATIENTS",0)=""
+3 if '$DATA(DUZ)
QUIT
+4 NEW FROM,IEN,BEG,END,API,DGSRV,DGQDAT,DGQCNT,DGGUI
+5 ; Get S/S.
SET DGSRV=$GET(^VA(200,DUZ,5))
IF +DGSRV>0
SET DGSRV=$PIECE(DGSRV,U)
+6 SET FROM=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT LIST SOURCE",1,"Q")
+7 if '$LENGTH($GET(FROM))
QUIT
+8 IF FROM="T"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT TEAM",1,"Q")
if +$GET(IEN)>0
DO TEAMPTS^DGQPTQ1(.Y,IEN)
+9 IF FROM="W"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT WARD",1,"Q")
if +$GET(IEN)>0
DO WARDPTS^DGQPTQ2(.Y,IEN)
+10 IF FROM="P"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT PROVIDER",1,"Q")
if +$GET(IEN)>0
DO PROVPTS^DGQPTQ2(.Y,IEN)
+11 IF FROM="S"
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),"DGLP DEFAULT SPECIALTY",1,"Q")
if +$GET(IEN)>0
DO SPECPTS^DGQPTQ2(.Y,IEN)
+12 IF FROM="C"
Begin DoDot:1
+13 SET API="DGLP DEFAULT CLINIC "_$$UP^XLFSTR($$DOW^XLFDT(DT))
SET IEN=$$GET^XPAR("USR^SRV.`"_+$GET(DGSRV),API,1,"Q")
IF +$GET(IEN)>0
Begin DoDot:2
+14 SET BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
+15 IF BEG="T+0"
SET BEG=$$FMTE^XLFDT(DT,BEG)
+16 SET END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
+17 IF END="T+0"
SET END=$$FMTE^XLFDT(DT,END)
+18 DO CLINPTS^DGQPTQ2(.Y,+$GET(IEN),BEG,END)
End DoDot:2
End DoDot:1
+19 ; Next section added by PKS:
+20 IF FROM="M"
Begin DoDot:1
+21 SET IEN=$DATA(^OR(100.24,DUZ,0))
IF +$GET(IEN)>0
SET IEN=DUZ
Begin DoDot:2
+22 SET BEG=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC START DATE",1,"E"))
+23 IF BEG="T+0"
SET BEG=$$FMTE^XLFDT(DT,BEG)
+24 SET END=$$UP^XLFSTR($$GET^XPAR("USR^SRV.`"_+$GET(DGSRV)_"^DIV^SYS^PKG","DGLP DEFAULT CLINIC STOP DATE",1,"E"))
+25 IF END="T+0"
SET END=$$FMTE^XLFDT(DT,END)
+26 ; "0"= GUI RPC call.
DO COMBPTS^DGQPTQ6(0,+$GET(IEN),BEG,END)
End DoDot:2
End DoDot:1
+27 ; Added by PKS - 3/2001, to write to global for GUI:
+28 ; Combinations already written to global.
IF ($$BROKER^XWBLIB)&(FROM'="M")
Begin DoDot:1
+29 ; Put list into a global:
+30 SET DGQDAT=""
SET DGQCNT=1
+31 FOR
SET DGQDAT=$GET(Y(DGQCNT))
if DGQDAT=""
QUIT
Begin DoDot:2
+32 SET ^TMP("DG",$JOB,"PATIENTS",DGQCNT,0)=DGQDAT
+33 SET DGQCNT=DGQCNT+1
End DoDot:2
End DoDot:1
+34 ; MKB 10/13/95
IF ('$$BROKER^XWBLIB)
SET Y=FROM_";"_+$GET(IEN)_";"_$GET(BEG)_";"_$GET(END)
+35 QUIT
DEFSORT(Y) ; Return user's default "sort" for patient selection lists.
+1 ; SLC/PKS - 4/6/2001
+2 ;
+3 NEW DGSORT,DGSECT,DGPARAM
+4 ;
+5 IF ('$DATA(DUZ))
SET Y="Unable to determine DUZ."
QUIT
+6 ;
+7 ; Get user's current service/section:
+8 SET DGSECT=$GET(^VA(200,DUZ,5))
+9 IF +DGSECT>0
SET DGSECT=$PIECE(DGSECT,U)
+10 ;
+11 ; Retrieve current sort parameter:
+12 ; Default of "Alpha" sort.
SET Y="A"
+13 SET DGPARAM="DGLP DEFAULT LIST ORDER"
+14 SET DGSORT=$$GET^XPAR("USR^SRV.`"_$GET(DGSECT)_"^DIV^SYS^PKG",DGPARAM,1,"I")
+15 IF (DGSORT'="")
SET Y=DGSORT
+16 ;
+17 QUIT
+18 ;
