ORLP3MGR ; SLC/AEB - Manager Options - Patient List Defaults ;9/22/97 [4/25/00 3:25pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,82,273**;Dec 17, 1997;Build 17
;;Per VHA Directive 2004-038, this routine should not be modified.
;
;DBIA reference section
;2992 - ^XTV(8989.51
;10086 - %ZIS
;10006 - DIC
;2051 - FIND1^DIC
;2054 - CLEAN^DILF
;10026 - DIR
;2336 - EDITPAR^XPAREDIT
;
CLSTRTD ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Start Date",PARAM="ORLP DEFAULT CLINIC START DATE"
D OPSETUP(ORLPT,PARAM)
Q
;
CLSTPD ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Stop Date",PARAM="ORLP DEFAULT CLINIC STOP DATE"
D OPSETUP(ORLPT,PARAM)
Q
;
CLSUN ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Sunday",PARAM="ORLP DEFAULT CLINIC SUNDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLMON ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Monday",PARAM="ORLP DEFAULT CLINIC MONDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLTUE ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Tuesday",PARAM="ORLP DEFAULT CLINIC TUESDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLWED ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Wednesday",PARAM="ORLP DEFAULT CLINIC WEDNESDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLTHUR ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Thursday",PARAM="ORLP DEFAULT CLINIC THURSDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLFRI ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Friday",PARAM="ORLP DEFAULT CLINIC FRIDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
CLSAT ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Saturday",PARAM="ORLP DEFAULT CLINIC SATURDAY"
D OPSETUP(ORLPT,PARAM)
Q
;
LSTORD ;
N ORLPT,PARAM
S ORLPT="Set Default Sort Order for Patient List",PARAM="ORLP DEFAULT LIST ORDER"
D OPSETUP(ORLPT,PARAM)
Q
;
LSTSRC ;
N ORLPT,PARAM
S ORLPT="Set Default List Source",PARAM="ORLP DEFAULT LIST SOURCE"
D OPSETUP(ORLPT,PARAM)
Q
;
PROVIDER ;
N ORLPT,PARAM
S ORLPT="Set Default Primary Provider",PARAM="ORLP DEFAULT PROVIDER"
D OPSETUP(ORLPT,PARAM)
Q
;
SPEC ;
N ORLPT,PARAM
S ORLPT="Set Default Treating Specialty",PARAM="ORLP DEFAULT SPECIALTY"
D OPSETUP(ORLPT,PARAM)
Q
;
TEAM ;
N ORLPT,PARAM
S ORLPT="Set Default Team List",PARAM="ORLP DEFAULT TEAM"
D OPSETUP(ORLPT,PARAM)
Q
;
WARD ;
N ORLPT,PARAM
S ORLPT="Set Default Ward",PARAM="ORLP DEFAULT WARD"
D OPSETUP(ORLPT,PARAM)
Q
;
OPSETUP(ORLPT,PARAM) ;
N ORLPPAR
S ORLPPAR=$O(^XTV(8989.51,"B",PARAM,0)) Q:ORLPPAR=""
D TITLE(ORLPT) D PROC(ORLPPAR)
Q
;
TITLE(ORLPT) ;
; Center and write title
S IOP=0 D ^%ZIS K IOP W @IOF
W !,?(80-$L(ORLPT)-1/2),ORLPT
Q
;
PROC(PAR) ; Process Parameter Settings
D EDITPAR^XPAREDIT(PAR)
Q
;
DEFSRC ; default list source and value for user
N ORX,ORLPLNM,ORLPDUZ,ORLPERR,ORLPRTN,ORLPCNT
; Get user DUZ number
K DIC,Y S DIC="^VA(200,",DIC(0)="AEQ",DIC("A")="Enter user's name: ",DIC("B")=DUZ D ^DIC Q:Y<1
S ORLPDUZ=$S(Y'<1:$P(Y,"^"),1:DUZ) K DIC,Y,DUOUT,DTOUT
Q:'$D(ORLPDUZ)
S ORX=$$FDEFSRC^ORQPTQ11(ORLPDUZ)
S ORLPLNM=$P(ORX,U,2)
W !!,"The user's default list of patients is based on: ",$P(ORX,U,3)," ",ORLPLNM,!
I ORLPLNM="Combination" D
.; Look for an existing record for this user:
.K ORLPERR
.S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
.K ORLPERR
.D CLEAN^DILF ; Clean up after DB call.
.;
.; If no combination record then punt:
.I +ORLPRTN<1 Q
.;
.; Print title for display of current entries:
.W !," User's current combination entries are:",!
.;
.; Call tag^routine to display existing combination sources:
.S ORLPCNT=0
.S ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,ORLPRTN)
.I ORLPCNT<1 W !,"No current combination entries...."
.W !
S DIR(0)="FOU",DIR("T")=10,DIR("A")="<RETURN> to continue"
I ORLPLNM="Combination" S DIR("T")=20 ; More time for combos.
D ^DIR
K DIR,Y,X,DTOUT,DUOUT,DIRUT
;
Q
;
UDEFSRC ; default list source and value for the user
; SLC/PKS - 3/2000: Modified to display "Combination" sources.
;
; Variables used:
;
; ORLPCNT = Holds return value from function call.
; ORLPDUZ = DUZ of current user.
; ORLPERR = Error array for return from DB calls.
; ORLPLNM = Name of default list source.
; ORLPRTN = Return value from DB calls.
; ORX = Holds default list source parameter.
;
N ORX,ORLPLNM,ORLPDUZ,ORLPERR,ORLPRTN,ORLPCNT
Q:'$D(DUZ)
S ORX=$$FDEFSRC^ORQPTQ11(DUZ)
S ORLPLNM=$P(ORX,U,2)
W !!,"Your default list of patients is based on: ",$P(ORX,U,3)," ",ORLPLNM,!
I ORLPLNM="Combination" D
.; Look for an existing record for this user:
.S ORLPDUZ=DUZ
.K ORLPERR
.S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
.K ORLPERR
.D CLEAN^DILF ; Clean up after DB call.
.;
.; If no combination record then punt:
.I +ORLPRTN<1 Q
.;
.; Print title for display of current entries:
.W !," Your current combination entries are:",!
.;
.; Call tag^routine to display existing combination sources:
.S ORLPCNT=0
.S ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,ORLPRTN)
.I ORLPCNT<1 W !,"No current combination entries...."
.W !
.;
.Q
;
; Allow user viewing with default timeout:
S DIR(0)="FOU",DIR("T")=10,DIR("A")="<RETURN> to continue"
I ORLPLNM="Combination" S DIR("T")=20 ; More time for combos.
D ^DIR
K DIR,Y,X,DTOUT,DUOUT,DIRUT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORLP3MGR 5380 printed Apr 09, 2024@21:41:20 Page 2
ORLP3MGR ; SLC/AEB - Manager Options - Patient List Defaults ;9/22/97 [4/25/00 3:25pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,82,273**;Dec 17, 1997;Build 17
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;DBIA reference section
+5 ;2992 - ^XTV(8989.51
+6 ;10086 - %ZIS
+7 ;10006 - DIC
+8 ;2051 - FIND1^DIC
+9 ;2054 - CLEAN^DILF
+10 ;10026 - DIR
+11 ;2336 - EDITPAR^XPAREDIT
+12 ;
CLSTRTD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Start Date"
SET PARAM="ORLP DEFAULT CLINIC START DATE"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLSTPD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Stop Date"
SET PARAM="ORLP DEFAULT CLINIC STOP DATE"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLSUN ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Sunday"
SET PARAM="ORLP DEFAULT CLINIC SUNDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLMON ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Monday"
SET PARAM="ORLP DEFAULT CLINIC MONDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLTUE ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Tuesday"
SET PARAM="ORLP DEFAULT CLINIC TUESDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLWED ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Wednesday"
SET PARAM="ORLP DEFAULT CLINIC WEDNESDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLTHUR ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Thursday"
SET PARAM="ORLP DEFAULT CLINIC THURSDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLFRI ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Friday"
SET PARAM="ORLP DEFAULT CLINIC FRIDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
CLSAT ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Saturday"
SET PARAM="ORLP DEFAULT CLINIC SATURDAY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
LSTORD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Sort Order for Patient List"
SET PARAM="ORLP DEFAULT LIST ORDER"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
LSTSRC ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default List Source"
SET PARAM="ORLP DEFAULT LIST SOURCE"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
PROVIDER ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Primary Provider"
SET PARAM="ORLP DEFAULT PROVIDER"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
SPEC ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Treating Specialty"
SET PARAM="ORLP DEFAULT SPECIALTY"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
TEAM ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Team List"
SET PARAM="ORLP DEFAULT TEAM"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
WARD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Ward"
SET PARAM="ORLP DEFAULT WARD"
+3 DO OPSETUP(ORLPT,PARAM)
+4 QUIT
+5 ;
OPSETUP(ORLPT,PARAM) ;
+1 NEW ORLPPAR
+2 SET ORLPPAR=$ORDER(^XTV(8989.51,"B",PARAM,0))
if ORLPPAR=""
QUIT
+3 DO TITLE(ORLPT)
DO PROC(ORLPPAR)
+4 QUIT
+5 ;
TITLE(ORLPT) ;
+1 ; Center and write title
+2 SET IOP=0
DO ^%ZIS
KILL IOP
WRITE @IOF
+3 WRITE !,?(80-$LENGTH(ORLPT)-1/2),ORLPT
+4 QUIT
+5 ;
PROC(PAR) ; Process Parameter Settings
+1 DO EDITPAR^XPAREDIT(PAR)
+2 QUIT
+3 ;
DEFSRC ; default list source and value for user
+1 NEW ORX,ORLPLNM,ORLPDUZ,ORLPERR,ORLPRTN,ORLPCNT
+2 ; Get user DUZ number
+3 KILL DIC,Y
SET DIC="^VA(200,"
SET DIC(0)="AEQ"
SET DIC("A")="Enter user's name: "
SET DIC("B")=DUZ
DO ^DIC
if Y<1
QUIT
+4 SET ORLPDUZ=$SELECT(Y'<1:$PIECE(Y,"^"),1:DUZ)
KILL DIC,Y,DUOUT,DTOUT
+5 if '$DATA(ORLPDUZ)
QUIT
+6 SET ORX=$$FDEFSRC^ORQPTQ11(ORLPDUZ)
+7 SET ORLPLNM=$PIECE(ORX,U,2)
+8 WRITE !!,"The user's default list of patients is based on: ",$PIECE(ORX,U,3)," ",ORLPLNM,!
+9 IF ORLPLNM="Combination"
Begin DoDot:1
+10 ; Look for an existing record for this user:
+11 KILL ORLPERR
+12 SET ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
+13 KILL ORLPERR
+14 ; Clean up after DB call.
DO CLEAN^DILF
+15 ;
+16 ; If no combination record then punt:
+17 IF +ORLPRTN<1
QUIT
+18 ;
+19 ; Print title for display of current entries:
+20 WRITE !," User's current combination entries are:",!
+21 ;
+22 ; Call tag^routine to display existing combination sources:
+23 SET ORLPCNT=0
+24 SET ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,ORLPRTN)
+25 IF ORLPCNT<1
WRITE !,"No current combination entries...."
+26 WRITE !
End DoDot:1
+27 SET DIR(0)="FOU"
SET DIR("T")=10
SET DIR("A")="<RETURN> to continue"
+28 ; More time for combos.
IF ORLPLNM="Combination"
SET DIR("T")=20
+29 DO ^DIR
+30 KILL DIR,Y,X,DTOUT,DUOUT,DIRUT
+31 ;
+32 QUIT
+33 ;
UDEFSRC ; default list source and value for the user
+1 ; SLC/PKS - 3/2000: Modified to display "Combination" sources.
+2 ;
+3 ; Variables used:
+4 ;
+5 ; ORLPCNT = Holds return value from function call.
+6 ; ORLPDUZ = DUZ of current user.
+7 ; ORLPERR = Error array for return from DB calls.
+8 ; ORLPLNM = Name of default list source.
+9 ; ORLPRTN = Return value from DB calls.
+10 ; ORX = Holds default list source parameter.
+11 ;
+12 NEW ORX,ORLPLNM,ORLPDUZ,ORLPERR,ORLPRTN,ORLPCNT
+13 if '$DATA(DUZ)
QUIT
+14 SET ORX=$$FDEFSRC^ORQPTQ11(DUZ)
+15 SET ORLPLNM=$PIECE(ORX,U,2)
+16 WRITE !!,"Your default list of patients is based on: ",$PIECE(ORX,U,3)," ",ORLPLNM,!
+17 IF ORLPLNM="Combination"
Begin DoDot:1
+18 ; Look for an existing record for this user:
+19 SET ORLPDUZ=DUZ
+20 KILL ORLPERR
+21 SET ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
+22 KILL ORLPERR
+23 ; Clean up after DB call.
DO CLEAN^DILF
+24 ;
+25 ; If no combination record then punt:
+26 IF +ORLPRTN<1
QUIT
+27 ;
+28 ; Print title for display of current entries:
+29 WRITE !," Your current combination entries are:",!
+30 ;
+31 ; Call tag^routine to display existing combination sources:
+32 SET ORLPCNT=0
+33 SET ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,ORLPRTN)
+34 IF ORLPCNT<1
WRITE !,"No current combination entries...."
+35 WRITE !
+36 ;
+37 QUIT
End DoDot:1
+38 ;
+39 ; Allow user viewing with default timeout:
+40 SET DIR(0)="FOU"
SET DIR("T")=10
SET DIR("A")="<RETURN> to continue"
+41 ; More time for combos.
IF ORLPLNM="Combination"
SET DIR("T")=20
+42 DO ^DIR
+43 KILL DIR,Y,X,DTOUT,DUOUT,DIRUT
+44 QUIT
+45 ;
