- 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 Feb 19, 2025@00:20:43 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 ;
