DGQPT1 ; SLC/MKB - Change Patient Selection List ;6/5/01 12:36pm
;;5.3;Registration;**447**;Aug 13, 1993
;
; SLC/PKS - 5/2000: Modified to deal with "Combinations."
;
CONTEXT() ; -- Returns current patient list context
Q $P($G(^TMP("DG",$J,"PATIENTS",0)),U,3)
;
WARD ; -- new ward list
N X,Y,DIC
D FULL^VALM1 S VALMBCK="R"
S DIC("B")=$P($$LISTSRC^DGQPTQ11(DUZ,"W"),U,2) ;added by CLA 8/4/97
S DIC("S")="N D0,X S D0=+Y D WIN^DGPMDDCF I 'X" ; inactive?
S DIC=42,DIC(0)="AEQM" D ^DIC Q:Y'>0 S $P(DGY,";",1,2)="W;"_+Y
Q
;
CLINIC ; -- new clinic list
N X,Y,Z,DIC,BEG,END,BEG1,END1
D FULL^VALM1 S VALMBCK="R"
S DIC("B")=$P($$LISTSRC^DGQPTQ11(DUZ,"C"),U,2) ;added by CLA 8/4/97
S DIC=44,DIC(0)="AEQM",DIC("A")="Select CLINIC: "
S DIC("S")="I $P(^(0),U,3)=""C"",$$ACTLOC^SDWU(+Y)"
D ^DIC Q:Y'>0 S (BEG1,END1)=""
S Z=$$DATE($P(ORY,";",3),1) Q:Z="^" S BEG=$P(Z,U),BEG1=$P(Z,U,2)
I BEG1 S Z=$$DATE($P(DGY,";",4),0) Q:Z="^" S END=$P(Z,U),END1=$P(Z,U,2)
I 'BEG1!'END1 Q
I BEG1,END1,END1<BEG1 S X=END,END=BEG,BEG=X ; switch
S $P(DGY,";",1,4)="C;"_+Y_";"_BEG_";"_END
Q
;
DATE(DEFLT,START) ; -- new start/stop date
N X,Y,DIR,%DT
S DIR(0)="FAO^1:20",DIR("A")=$S($G(START):"START",1:"STOP")_" DATE: "
S:$L($G(DEFLT)) DIR("B")=DEFLT
S DIR("?")="Enter the "_$S($G(START):"earliest",1:"latest")_" date for appointments to this clinic for which you wish to see the patients listed; indicate the date relative to TODAY, i.e. T+1 for tomorrow or T-2W for 2 weeks ago."
D1 D ^DIR S:$D(DTOUT) X="^"
I "^"'[X S %DT="X" D ^%DT S:Y>0 X=X_U_Y I Y'>0 W $C(7),!,DIR("?"),! G D1
Q X
;
PROV ; -- new provider list
N X,Y,DIC
D FULL^VALM1 S VALMBCK="R"
S DIC("B")=$P($$LISTSRC^DGQPTQ11(DUZ,"P"),U,2) ;added by CLA 8/4/97
S DIC=200,DIC(0)="AEQ",DIC("A")="Select PROVIDER: ",D="AK.PROVIDER"
D IX^DIC Q:Y'>0 S $P(DGY,";",1,2)="P;"_+Y
Q
;
TEAM ; -- new team list
N X,Y,DIC
D FULL^VALM1 S VALMBCK="R"
S DIC("B")=$P($$LISTSRC^DGQPTQ11(DUZ,"T"),U,2) ;added by CLA 8/4/97
S DIC=100.21,DIC(0)="AEQM",DIC("A")="Select TEAM: "
D ^DIC Q:Y'>0 S $P(DGY,";",1,2)="T;"_+Y
Q
;
SPEC ; -- new treating specialty list
N X,Y,DIC
D FULL^VALM1 S VALMBCK="R"
S DIC("B")=$P($$LISTSRC^DGQPTQ11(DUZ,"S"),U,2) ;added by CLA 8/4/97
S DIC=45.7,DIC(0)="AEQM",DIC("S")="I $$ACTIVE^DGACT(45.7,Y,DT)"
D ^DIC Q:Y'>0 S $P(DGY,";",1,2)="S;"_+Y
Q
;
SORT ; -- new sort order
N X,Y,DIR
S X=($E(DGY)="C"),Y=$P(DGY,";",5)
S DIR(0)="SAM^A:Alphabetic;"_$S(X:"P:Date of Appointment;",1:"R:Room-Bed;")
S DIR("A")="(A)lphabetic or "_$S(X:"Date of A(p)pointment? ",1:"(R)oom-Bed? ")
S DIR("B")=$S(Y="R"&'X:"Room-Bed",Y="P"&X:"Date of Appointment",1:"Alphabetic")
; Next 4 lines added by PKS to deal with "Combinations:"
I $E(ORY)="M" D
. S DIR(0)="SAM^A:Alphabetic;P:Appointment;S:Source"
. S DIR("A")="(A)lphabetic or Date of A(p)pointment or (S)ource "
. S DIR("B")="Alphabetic"
S DIR("?")="Enter the attribute you wish the list to sort by"
D ^DIR S:$D(DTOUT) Y="^" Q:Y="^"
S $P(DGY,";",5)=Y
Q
;
SAVE ; -- Save current list definition as default
N X,LIST,IFN,BEG,END,PARAM S VALMBCK=""
Q:'$$OK W !!,"Saving patient list definition ... "
S LIST=$$CONTEXT,X=$E(LIST)
; Next line modified by PKS:
S PARAM="DGLP DEFAULT "_$S(X="T":"TEAM",X="P":"PROVIDER",X="S":"SPECIALTY",X="W":"WARD",X="C":"CLINIC ",X="M":"MULTIPLE",1:"^") I PARAM["^" W !,"ERROR" H 2 Q
;added by CLA 12/12/96:
N DGSRV S DGSRV=$G(^VA(200,DUZ,5)) I +DGSRV>0 S DGSRV=$P(DGSRV,U)
;
D EN^XPAR("USR","DGLP DEFAULT LIST SOURCE",1,X)
S IFN="`"_+$P(LIST,";",2)
I X'="C" D EN^XPAR("USR",PARAM,1,IFN)
I X="C" D ; add clinic for each day of week & start & stop dates
. N CPARAM
. S CPARAM=PARAM_"MONDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"TUESDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"WEDNESDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"THURSDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"FRIDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"SATURDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S CPARAM=PARAM_"SUNDAY" D EN^XPAR("USR",CPARAM,1,IFN)
. S BEG=$P(LIST,";",3),END=$P(LIST,";",4)
. D EN^XPAR("USR","DGLP DEFAULT CLINIC START DATE",1,BEG)
. D EN^XPAR("USR","DGLP DEFAULT CLINIC STOP DATE",1,END)
I $L($P(LIST,";",5)) D EN^XPAR("USR","DGLP DEFAULT LIST ORDER",1,$P(LIST,";",5))
W "done." H 1 S VALMBCK=""
Q
;
OK() ; -- Current definition ok?
N X,Y,DIR,LIST,PTR,SORT,BEG,END W !!,"Current List: "
S LIST=$$CONTEXT,PTR=+$P(LIST,";",2),BEG=$P(LIST,";",3),END=$P(LIST,";",4),SORT=$P(LIST,";",5)
I $E(LIST)="W" W "Ward "_$P($G(^DIC(42,+PTR,0)),U)
I $E(LIST)="C" W "Clinic "_$P($G(^SC(+PTR,0)),U)
I $E(LIST)="P" W "Primary Provider "_$P($G(^VA(200,+PTR,0)),U)
I $E(LIST)="T" W "Team "_$P($G(^OR(100.21,+PTR,0)),U)
I $E(LIST)="S" W "Specialty "_$P($G(^DIC(45.7,+PTR,0)),U)
; Next line added by PKS:
I $E(LIST)="M" W "Combination"
I $L(SORT) W ", sorted by "_$S(SORT="P":"Appointment Date",SORT="R":"Room-Bed",1:"Name")
I $E(LIST)="C",BEG W !?14,"from "_BEG_" to "_END
S DIR(0)="YA",DIR("A")="Are you sure you want to save these list parameters as your default? "
S DIR("?")="Enter YES if you wish to use these same parameters again the next time a patient list is created for you to select from, or NO to quit without saving."
W ! D ^DIR
Q +Y
;
REMOVE ; Remove current default patient list view parameter setting(s).
; SLC/PKS - 5/2000.
;
; Variables used:
;
; DGDUZ = User's DUZ.
; DGQENT = Entity string for call to XPAR.
; DGQERR = Error array for call to XPAR.
; DGQSRC = Holds return value of call to FDEFSRC^ORQPTQ11(ORDUZ).
;
N DGQDUZ,DGQENT,DGQERR,DGQSRC
;
K DGQERR
S VALMBCK=""
S DGQDUZ=DUZ
Q:'$$OKR
W !!,"Removing your personal patient list definition ... "
S DGQENT=DUZ_";VA(200,"
D DEL^XPAR(DGQENT,"DGLP DEFAULT LIST SOURCE",,.ORQERR)
I ('$D(DGQERR)!(DGQERR=0)) D
.W "done."
.S DGQSRC=$$FDEFSRC^DGQPTQ11(DGQDUZ) ; Check for Service default.
.I $P(DGQSRC,U)'="" W !,"(NOTE: Service/Section default of """_$P(DGQSRC,U,3)_""" not affected.)"
.H 4
I $D(DGQERR) D
.S DGQSRC=$$FDEFSRC^DGQPTQ11(DGQDUZ) ; Check for Service default.
.I DGQERR=0 Q
.I $P(DGQERR,U,2)="Parameter instance not found" D Q
..W "nothing to remove."
..I $P(DGQSRC,U)'="" W !,"(NOTE: Service/Section default of """_$P(DGQSRC,U,3)_""" not affected.)"
..H 4
.W !," ERROR: "_$P(DGQERR,U,2) H 3
S VALMBCK=""
Q
;
OKR() ; -- Remove current definition?
N X,Y,DIR,LIST,PTR
S DIR(0)="YA"
S DIR("A")="Are you sure you want to remove your current list default view? "
S DIR("?")="Enter YES if you wish to remove your current default patient list view, or NO to leave the current personal setting(s)."
W ! ; For display esthetics.
D ^DIR
Q +Y
;
COMBO ; New combination list.
; SLC/PKS - 5/2000.
;
; Preset VALM for return:
D FULL^VALM1 S VALMBCK="R"
;
; Call existing code to create/edit user's "combination" sources:
D COMB^DGLP3USR
;
; Write the piece in "ORY" to indicate "Combination" sources:
S $P(DGY,";",1)="M"
D REBUILD
;
Q
;
REBUILD ; -- Ok to rebuild listing?
N DGQUIT
I $E(DGY)="C",$P(DGY,";",5)="R" D Q:$G(DGQUIT)
. W !!,">> A Clinic list cannot be sorted by room-bed assignment!"
. W !," Please select a new sorting order:",!
. D SORT S:$P(DGY,";",5)="R" DGQUIT=1
; Next section added by PKS for "Combinations:"
I $E(DGY)="M",$P(DGY,";",5)="R" D Q:$G(DGQUIT)
. W !!,">> A Combination list cannot be sorted by room-bed assignment!"
. W !," Please select a new sorting order:",!
. D SORT S:$P(DGY,";",5)="R" DGQUIT=1
I (($E(DGY)'="C")&($E(DGY)'="M")),$P(DGY,";",5)="P" D Q:$G(DGQUIT)
. W !!,">> A "_$S($E(DGY)="W":"Ward",$E(DGY)="P":"Primary Provider",$E(DGY)="T":"Team",$E(DGY)="S":"Specialty",1:"")_" list cannot be sorted by clinic appointment date!"
. W !," Please select a new sorting order:",!
. D SORT S:$P(DGY,";",5)="P" DGQUIT=1
D BUILD^DGQPT(DGY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGQPT1 8065 printed Sep 23, 2025@20:30:31 Page 2
DGQPT1 ; SLC/MKB - Change Patient Selection List ;6/5/01 12:36pm
+1 ;;5.3;Registration;**447**;Aug 13, 1993
+2 ;
+3 ; SLC/PKS - 5/2000: Modified to deal with "Combinations."
+4 ;
CONTEXT() ; -- Returns current patient list context
+1 QUIT $PIECE($GET(^TMP("DG",$JOB,"PATIENTS",0)),U,3)
+2 ;
WARD ; -- new ward list
+1 NEW X,Y,DIC
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;added by CLA 8/4/97
SET DIC("B")=$PIECE($$LISTSRC^DGQPTQ11(DUZ,"W"),U,2)
+4 ; inactive?
SET DIC("S")="N D0,X S D0=+Y D WIN^DGPMDDCF I 'X"
+5 SET DIC=42
SET DIC(0)="AEQM"
DO ^DIC
if Y'>0
QUIT
SET $PIECE(DGY,";",1,2)="W;"_+Y
+6 QUIT
+7 ;
CLINIC ; -- new clinic list
+1 NEW X,Y,Z,DIC,BEG,END,BEG1,END1
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;added by CLA 8/4/97
SET DIC("B")=$PIECE($$LISTSRC^DGQPTQ11(DUZ,"C"),U,2)
+4 SET DIC=44
SET DIC(0)="AEQM"
SET DIC("A")="Select CLINIC: "
+5 SET DIC("S")="I $P(^(0),U,3)=""C"",$$ACTLOC^SDWU(+Y)"
+6 DO ^DIC
if Y'>0
QUIT
SET (BEG1,END1)=""
+7 SET Z=$$DATE($PIECE(ORY,";",3),1)
if Z="^"
QUIT
SET BEG=$PIECE(Z,U)
SET BEG1=$PIECE(Z,U,2)
+8 IF BEG1
SET Z=$$DATE($PIECE(DGY,";",4),0)
if Z="^"
QUIT
SET END=$PIECE(Z,U)
SET END1=$PIECE(Z,U,2)
+9 IF 'BEG1!'END1
QUIT
+10 ; switch
IF BEG1
IF END1
IF END1<BEG1
SET X=END
SET END=BEG
SET BEG=X
+11 SET $PIECE(DGY,";",1,4)="C;"_+Y_";"_BEG_";"_END
+12 QUIT
+13 ;
DATE(DEFLT,START) ; -- new start/stop date
+1 NEW X,Y,DIR,%DT
+2 SET DIR(0)="FAO^1:20"
SET DIR("A")=$SELECT($GET(START):"START",1:"STOP")_" DATE: "
+3 if $LENGTH($GET(DEFLT))
SET DIR("B")=DEFLT
+4 SET DIR("?")="Enter the "_$SELECT($GET(START):"earliest",1:"latest")_" date for appointments to this clinic for which you wish to see the patients listed; indicate the date relative to TODAY, i.e. T+1 for tomorrow or T-2W for 2 weeks ago."
D1 DO ^DIR
if $DATA(DTOUT)
SET X="^"
+1 IF "^"'[X
SET %DT="X"
DO ^%DT
if Y>0
SET X=X_U_Y
IF Y'>0
WRITE $CHAR(7),!,DIR("?"),!
GOTO D1
+2 QUIT X
+3 ;
PROV ; -- new provider list
+1 NEW X,Y,DIC
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;added by CLA 8/4/97
SET DIC("B")=$PIECE($$LISTSRC^DGQPTQ11(DUZ,"P"),U,2)
+4 SET DIC=200
SET DIC(0)="AEQ"
SET DIC("A")="Select PROVIDER: "
SET D="AK.PROVIDER"
+5 DO IX^DIC
if Y'>0
QUIT
SET $PIECE(DGY,";",1,2)="P;"_+Y
+6 QUIT
+7 ;
TEAM ; -- new team list
+1 NEW X,Y,DIC
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;added by CLA 8/4/97
SET DIC("B")=$PIECE($$LISTSRC^DGQPTQ11(DUZ,"T"),U,2)
+4 SET DIC=100.21
SET DIC(0)="AEQM"
SET DIC("A")="Select TEAM: "
+5 DO ^DIC
if Y'>0
QUIT
SET $PIECE(DGY,";",1,2)="T;"_+Y
+6 QUIT
+7 ;
SPEC ; -- new treating specialty list
+1 NEW X,Y,DIC
+2 DO FULL^VALM1
SET VALMBCK="R"
+3 ;added by CLA 8/4/97
SET DIC("B")=$PIECE($$LISTSRC^DGQPTQ11(DUZ,"S"),U,2)
+4 SET DIC=45.7
SET DIC(0)="AEQM"
SET DIC("S")="I $$ACTIVE^DGACT(45.7,Y,DT)"
+5 DO ^DIC
if Y'>0
QUIT
SET $PIECE(DGY,";",1,2)="S;"_+Y
+6 QUIT
+7 ;
SORT ; -- new sort order
+1 NEW X,Y,DIR
+2 SET X=($EXTRACT(DGY)="C")
SET Y=$PIECE(DGY,";",5)
+3 SET DIR(0)="SAM^A:Alphabetic;"_$SELECT(X:"P:Date of Appointment;",1:"R:Room-Bed;")
+4 SET DIR("A")="(A)lphabetic or "_$SELECT(X:"Date of A(p)pointment? ",1:"(R)oom-Bed? ")
+5 SET DIR("B")=$SELECT(Y="R"&'X:"Room-Bed",Y="P"&X:"Date of Appointment",1:"Alphabetic")
+6 ; Next 4 lines added by PKS to deal with "Combinations:"
+7 IF $EXTRACT(ORY)="M"
Begin DoDot:1
+8 SET DIR(0)="SAM^A:Alphabetic;P:Appointment;S:Source"
+9 SET DIR("A")="(A)lphabetic or Date of A(p)pointment or (S)ource "
+10 SET DIR("B")="Alphabetic"
End DoDot:1
+11 SET DIR("?")="Enter the attribute you wish the list to sort by"
+12 DO ^DIR
if $DATA(DTOUT)
SET Y="^"
if Y="^"
QUIT
+13 SET $PIECE(DGY,";",5)=Y
+14 QUIT
+15 ;
SAVE ; -- Save current list definition as default
+1 NEW X,LIST,IFN,BEG,END,PARAM
SET VALMBCK=""
+2 if '$$OK
QUIT
WRITE !!,"Saving patient list definition ... "
+3 SET LIST=$$CONTEXT
SET X=$EXTRACT(LIST)
+4 ; Next line modified by PKS:
+5 SET PARAM="DGLP DEFAULT "_$SELECT(X="T":"TEAM",X="P":"PROVIDER",X="S":"SPECIALTY",X="W":"WARD",X="C":"CLINIC ",X="M":"MULTIPLE",1:"^")
IF PARAM["^"
WRITE !,"ERROR"
HANG 2
QUIT
+6 ;added by CLA 12/12/96:
+7 NEW DGSRV
SET DGSRV=$GET(^VA(200,DUZ,5))
IF +DGSRV>0
SET DGSRV=$PIECE(DGSRV,U)
+8 ;
+9 DO EN^XPAR("USR","DGLP DEFAULT LIST SOURCE",1,X)
+10 SET IFN="`"_+$PIECE(LIST,";",2)
+11 IF X'="C"
DO EN^XPAR("USR",PARAM,1,IFN)
+12 ; add clinic for each day of week & start & stop dates
IF X="C"
Begin DoDot:1
+13 NEW CPARAM
+14 SET CPARAM=PARAM_"MONDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+15 SET CPARAM=PARAM_"TUESDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+16 SET CPARAM=PARAM_"WEDNESDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+17 SET CPARAM=PARAM_"THURSDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+18 SET CPARAM=PARAM_"FRIDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+19 SET CPARAM=PARAM_"SATURDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+20 SET CPARAM=PARAM_"SUNDAY"
DO EN^XPAR("USR",CPARAM,1,IFN)
+21 SET BEG=$PIECE(LIST,";",3)
SET END=$PIECE(LIST,";",4)
+22 DO EN^XPAR("USR","DGLP DEFAULT CLINIC START DATE",1,BEG)
+23 DO EN^XPAR("USR","DGLP DEFAULT CLINIC STOP DATE",1,END)
End DoDot:1
+24 IF $LENGTH($PIECE(LIST,";",5))
DO EN^XPAR("USR","DGLP DEFAULT LIST ORDER",1,$PIECE(LIST,";",5))
+25 WRITE "done."
HANG 1
SET VALMBCK=""
+26 QUIT
+27 ;
OK() ; -- Current definition ok?
+1 NEW X,Y,DIR,LIST,PTR,SORT,BEG,END
WRITE !!,"Current List: "
+2 SET LIST=$$CONTEXT
SET PTR=+$PIECE(LIST,";",2)
SET BEG=$PIECE(LIST,";",3)
SET END=$PIECE(LIST,";",4)
SET SORT=$PIECE(LIST,";",5)
+3 IF $EXTRACT(LIST)="W"
WRITE "Ward "_$PIECE($GET(^DIC(42,+PTR,0)),U)
+4 IF $EXTRACT(LIST)="C"
WRITE "Clinic "_$PIECE($GET(^SC(+PTR,0)),U)
+5 IF $EXTRACT(LIST)="P"
WRITE "Primary Provider "_$PIECE($GET(^VA(200,+PTR,0)),U)
+6 IF $EXTRACT(LIST)="T"
WRITE "Team "_$PIECE($GET(^OR(100.21,+PTR,0)),U)
+7 IF $EXTRACT(LIST)="S"
WRITE "Specialty "_$PIECE($GET(^DIC(45.7,+PTR,0)),U)
+8 ; Next line added by PKS:
+9 IF $EXTRACT(LIST)="M"
WRITE "Combination"
+10 IF $LENGTH(SORT)
WRITE ", sorted by "_$SELECT(SORT="P":"Appointment Date",SORT="R":"Room-Bed",1:"Name")
+11 IF $EXTRACT(LIST)="C"
IF BEG
WRITE !?14,"from "_BEG_" to "_END
+12 SET DIR(0)="YA"
SET DIR("A")="Are you sure you want to save these list parameters as your default? "
+13 SET DIR("?")="Enter YES if you wish to use these same parameters again the next time a patient list is created for you to select from, or NO to quit without saving."
+14 WRITE !
DO ^DIR
+15 QUIT +Y
+16 ;
REMOVE ; Remove current default patient list view parameter setting(s).
+1 ; SLC/PKS - 5/2000.
+2 ;
+3 ; Variables used:
+4 ;
+5 ; DGDUZ = User's DUZ.
+6 ; DGQENT = Entity string for call to XPAR.
+7 ; DGQERR = Error array for call to XPAR.
+8 ; DGQSRC = Holds return value of call to FDEFSRC^ORQPTQ11(ORDUZ).
+9 ;
+10 NEW DGQDUZ,DGQENT,DGQERR,DGQSRC
+11 ;
+12 KILL DGQERR
+13 SET VALMBCK=""
+14 SET DGQDUZ=DUZ
+15 if '$$OKR
QUIT
+16 WRITE !!,"Removing your personal patient list definition ... "
+17 SET DGQENT=DUZ_";VA(200,"
+18 DO DEL^XPAR(DGQENT,"DGLP DEFAULT LIST SOURCE",,.ORQERR)
+19 IF ('$DATA(DGQERR)!(DGQERR=0))
Begin DoDot:1
+20 WRITE "done."
+21 ; Check for Service default.
SET DGQSRC=$$FDEFSRC^DGQPTQ11(DGQDUZ)
+22 IF $PIECE(DGQSRC,U)'=""
WRITE !,"(NOTE: Service/Section default of """_$PIECE(DGQSRC,U,3)_""" not affected.)"
+23 HANG 4
End DoDot:1
+24 IF $DATA(DGQERR)
Begin DoDot:1
+25 ; Check for Service default.
SET DGQSRC=$$FDEFSRC^DGQPTQ11(DGQDUZ)
+26 IF DGQERR=0
QUIT
+27 IF $PIECE(DGQERR,U,2)="Parameter instance not found"
Begin DoDot:2
+28 WRITE "nothing to remove."
+29 IF $PIECE(DGQSRC,U)'=""
WRITE !,"(NOTE: Service/Section default of """_$PIECE(DGQSRC,U,3)_""" not affected.)"
+30 HANG 4
End DoDot:2
QUIT
+31 WRITE !," ERROR: "_$PIECE(DGQERR,U,2)
HANG 3
End DoDot:1
+32 SET VALMBCK=""
+33 QUIT
+34 ;
OKR() ; -- Remove current definition?
+1 NEW X,Y,DIR,LIST,PTR
+2 SET DIR(0)="YA"
+3 SET DIR("A")="Are you sure you want to remove your current list default view? "
+4 SET DIR("?")="Enter YES if you wish to remove your current default patient list view, or NO to leave the current personal setting(s)."
+5 ; For display esthetics.
WRITE !
+6 DO ^DIR
+7 QUIT +Y
+8 ;
COMBO ; New combination list.
+1 ; SLC/PKS - 5/2000.
+2 ;
+3 ; Preset VALM for return:
+4 DO FULL^VALM1
SET VALMBCK="R"
+5 ;
+6 ; Call existing code to create/edit user's "combination" sources:
+7 DO COMB^DGLP3USR
+8 ;
+9 ; Write the piece in "ORY" to indicate "Combination" sources:
+10 SET $PIECE(DGY,";",1)="M"
+11 DO REBUILD
+12 ;
+13 QUIT
+14 ;
REBUILD ; -- Ok to rebuild listing?
+1 NEW DGQUIT
+2 IF $EXTRACT(DGY)="C"
IF $PIECE(DGY,";",5)="R"
Begin DoDot:1
+3 WRITE !!,">> A Clinic list cannot be sorted by room-bed assignment!"
+4 WRITE !," Please select a new sorting order:",!
+5 DO SORT
if $PIECE(DGY,";",5)="R"
SET DGQUIT=1
End DoDot:1
if $GET(DGQUIT)
QUIT
+6 ; Next section added by PKS for "Combinations:"
+7 IF $EXTRACT(DGY)="M"
IF $PIECE(DGY,";",5)="R"
Begin DoDot:1
+8 WRITE !!,">> A Combination list cannot be sorted by room-bed assignment!"
+9 WRITE !," Please select a new sorting order:",!
+10 DO SORT
if $PIECE(DGY,";",5)="R"
SET DGQUIT=1
End DoDot:1
if $GET(DGQUIT)
QUIT
+11 IF (($EXTRACT(DGY)'="C")&($EXTRACT(DGY)'="M"))
IF $PIECE(DGY,";",5)="P"
Begin DoDot:1
+12 WRITE !!,">> A "_$SELECT($EXTRACT(DGY)="W":"Ward",$EXTRACT(DGY)="P":"Primary Provider",$EXTRACT(DGY)="T":"Team",$EXTRACT(DGY)="S":"Specialty",1:"")_" list cannot be sorted by clinic appointment date!"
+13 WRITE !," Please select a new sorting order:",!
+14 DO SORT
if $PIECE(DGY,";",5)="P"
SET DGQUIT=1
End DoDot:1
if $GET(DGQUIT)
QUIT
+15 DO BUILD^DGQPT(DGY)
+16 QUIT
