DGLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97
;;5.3;Registration;**447**;Aug 13, 1993
;
; SLC/PKS - Modifications for "combinations" - 3/2000.
;
CLSTRTD ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Start Date",PARAM="DGLP DEFAULT CLINIC START DATE"
D PROC(DGLPT,PARAM)
Q
CLSTPD ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Stop Date",PARAM="DGLP DEFAULT CLINIC STOP DATE"
D PROC(DGLPT,PARAM)
Q
CLSUN ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Sunday",PARAM="DGLP DEFAULT CLINIC SUNDAY"
D PROC(DGLPT,PARAM)
Q
CLMON ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Monday",PARAM="DGLP DEFAULT CLINIC MONDAY"
D PROC(DGLPT,PARAM)
Q
CLTUE ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Tuesday",PARAM="DGLP DEFAULT CLINIC TUESDAY"
D PROC(DGLPT,PARAM)
Q
CLWED ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Wednesday",PARAM="DGLP DEFAULT CLINIC WEDNESDAY"
D PROC(DGLPT,PARAM)
Q
CLTHUR ;
N DGLPT,PARAM
S DGLPT="Set Defalt Clinic Thursday",PARAM="DGLP DEFAULT CLINIC THURSDAY"
D PROC(DGLPT,PARAM)
Q
CLFRI ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Friday",PARAM="DGLP DEFAULT CLINIC FRIDAY"
D PROC(DGLPT,PARAM)
Q
CLSAT ;
N DGLPT,PARAM
S DGLPT="Set Default Clinic Saturday",PARAM="DGLP DEFAULT CLINIC SATURDAY"
D PROC(DGLPT,PARAM)
Q
LSTORD ;
N DGLPT,PARAM
S DGLPT="Set Default Sort Order for Patient List",PARAM="DGLP DEFAULT LIST ORDER"
D PROC(DGLPT,PARAM)
Q
LSTSRC ;
N DGLPT,PARAM
S DGLPT="Set Default List Source",PARAM="DGLP DEFAULT LIST SOURCE"
D PROC(DGLPT,PARAM)
Q
PROVIDER ;
N DGLPT,PARAM
S DGLPT="Set Default Primary Provider",PARAM="DGLP DEFAULT PROVIDER"
D PROC(DGLPT,PARAM)
Q
SPEC ;
N DGLPT,PARAM
S DGLPT="Set Default Treating Specialty",PARAM="DGLP DEFAULT SPECIALTY"
D PROC(DGLPT,PARAM)
Q
TEAM ;
N DGLPT,PARAM
S DGLPT="Set Default Team List",PARAM="DGLP DEFAULT TEAM"
D PROC(DGLPT,PARAM)
Q
WARD ;
N DGLPT,PARAM
S DGLPT="Set Default Ward",PARAM="DGLP DEFAULT WARD"
D PROC(DGLPT,PARAM)
Q
;
COMB ; Set default combination sources.
; SLC/PKS - 3/2000
;
; Variables used:
;
; DA,DIE,DR = DIE variables.
; DGLPCNT = Holds return value from function call.
; DGLPDASH = Screen "-" character write holder.
; DGLPDUZ = DUZ of current user.
; DGLPERR = Error array for return by DB calls.
; DGLPFDA = Namespaced required DB call variable.
; DGLPIEN = Array for DB call.
; DGLPRTN = Holds value returned by DB calls.
; DGLPUNM = Name of current user from ^VA(200, file.
;
N DA,DIE,DR,DGLPCNT,DGLPDASH,DGLPDUZ,DGLPERR,DGLPFDA,DGLPIEN,DGLPRTN,DGLPUNM
;
; Find existing record for this user:
I '$D(DUZ) W !,"No user DUZ info." Q
S DGLPDUZ=DUZ
K DGLPERR
S DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
K DGLPERR
D CLEAN^DILF ; Clean up after DB call.
;
; Create a record if one does not exist:
I DGLPRTN<1 D
.K DGLPERR
.S DGLPFDA(100.24,"+1,",.01)=DGLPDUZ
.S DGLPIEN(1)=DGLPDUZ ; Set up for DINUM record insertion.
.D UPDATE^DIE("S","DGLPFDA","DGLPIEN","DGLPERR")
.K DGLPFDA
.K DGLPERR
.D CLEAN^DILF ; Clean up after DB call.
.S DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
.K DGLPERR
.D CLEAN^DILF ; Clean up after DB call.
;
; Check - record should now exist in any case:
I +DGLPRTN<1 W !,"Unable to create an entry for user: "_DGLPDUZ_"!" Q
;
; Display title for existing entries:
D TITLE("Set Default Combination")
W !,$$DASH($S($D(IOM):IOM-1,1:78))
W !!," Your current combination entries are:",!
;
; Make a call to tag that displays existing entries:
S DGLPCNT=0
S DGLPCNT=$$COMBDISP^DGQPTQ5(DGLPDUZ,+DGLPRTN)
I DGLPCNT=0 W !,"No current combination entries...."
;
S DGLPUNM=$P($G(^VA(200,DGLPDUZ,0)),U,1) ; Get user's name.
S DGLPUNM="Setting for user: "_DGLPUNM ; Construct title string.
S DGLPCNT=(($S($D(IOM):IOM,1:80)-$L(DGLPUNM))\2)-2
S DGLPDASH=""
S $P(DGLPDASH,"-",DGLPCNT+1)=""
W !!,DGLPDASH_" "_DGLPUNM_" "_DGLPDASH ; Write title w/dashes.
;
; Set variables and call DIE to allow user editing of combination:
S DIE="^OR(100.24,"
S DA=+DGLPRTN
S DR="1"
S DR(.01,100.241)=".01"
D ^DIE
;
Q
;
PROC(DGLPT,PARAM) ; Process Parameter Settings
N ENT,PAR
D TITLE(DGLPT)
S PAR=$O(^XTV(8989.51,"B",PARAM,0)) Q:PAR=""
S ENT=DUZ_";VA(200," ; Entity is the user
W !,$$DASH($S($D(IOM):IOM-1,1:78))
D EDIT^XPAREDIT(ENT,PAR)
Q
;
TITLE(DGBT) ;
; Center and write title
S IOP=0 D ^%ZIS K IOP W @IOF
W !,?(80-$L(DGBT)-1/2),DGBT
Q
;
DASH(N) ;extrinsic function returns N dashes
N X
S $P(X,"-",N+1)=""
Q X
XCHGPOS ; exchange the users associated with positions/teams
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGLP3USR 4759 printed Apr 09, 2024@21:51:10 Page 2
DGLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97
+1 ;;5.3;Registration;**447**;Aug 13, 1993
+2 ;
+3 ; SLC/PKS - Modifications for "combinations" - 3/2000.
+4 ;
CLSTRTD ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Start Date"
SET PARAM="DGLP DEFAULT CLINIC START DATE"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLSTPD ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Stop Date"
SET PARAM="DGLP DEFAULT CLINIC STOP DATE"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLSUN ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Sunday"
SET PARAM="DGLP DEFAULT CLINIC SUNDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLMON ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Monday"
SET PARAM="DGLP DEFAULT CLINIC MONDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLTUE ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Tuesday"
SET PARAM="DGLP DEFAULT CLINIC TUESDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLWED ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Wednesday"
SET PARAM="DGLP DEFAULT CLINIC WEDNESDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLTHUR ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Defalt Clinic Thursday"
SET PARAM="DGLP DEFAULT CLINIC THURSDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLFRI ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Friday"
SET PARAM="DGLP DEFAULT CLINIC FRIDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
CLSAT ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Clinic Saturday"
SET PARAM="DGLP DEFAULT CLINIC SATURDAY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
LSTORD ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Sort Order for Patient List"
SET PARAM="DGLP DEFAULT LIST ORDER"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
LSTSRC ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default List Source"
SET PARAM="DGLP DEFAULT LIST SOURCE"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
PROVIDER ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Primary Provider"
SET PARAM="DGLP DEFAULT PROVIDER"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
SPEC ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Treating Specialty"
SET PARAM="DGLP DEFAULT SPECIALTY"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
TEAM ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Team List"
SET PARAM="DGLP DEFAULT TEAM"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
WARD ;
+1 NEW DGLPT,PARAM
+2 SET DGLPT="Set Default Ward"
SET PARAM="DGLP DEFAULT WARD"
+3 DO PROC(DGLPT,PARAM)
+4 QUIT
+5 ;
COMB ; Set default combination sources.
+1 ; SLC/PKS - 3/2000
+2 ;
+3 ; Variables used:
+4 ;
+5 ; DA,DIE,DR = DIE variables.
+6 ; DGLPCNT = Holds return value from function call.
+7 ; DGLPDASH = Screen "-" character write holder.
+8 ; DGLPDUZ = DUZ of current user.
+9 ; DGLPERR = Error array for return by DB calls.
+10 ; DGLPFDA = Namespaced required DB call variable.
+11 ; DGLPIEN = Array for DB call.
+12 ; DGLPRTN = Holds value returned by DB calls.
+13 ; DGLPUNM = Name of current user from ^VA(200, file.
+14 ;
+15 NEW DA,DIE,DR,DGLPCNT,DGLPDASH,DGLPDUZ,DGLPERR,DGLPFDA,DGLPIEN,DGLPRTN,DGLPUNM
+16 ;
+17 ; Find existing record for this user:
+18 IF '$DATA(DUZ)
WRITE !,"No user DUZ info."
QUIT
+19 SET DGLPDUZ=DUZ
+20 KILL DGLPERR
+21 SET DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
+22 KILL DGLPERR
+23 ; Clean up after DB call.
DO CLEAN^DILF
+24 ;
+25 ; Create a record if one does not exist:
+26 IF DGLPRTN<1
Begin DoDot:1
+27 KILL DGLPERR
+28 SET DGLPFDA(100.24,"+1,",.01)=DGLPDUZ
+29 ; Set up for DINUM record insertion.
SET DGLPIEN(1)=DGLPDUZ
+30 DO UPDATE^DIE("S","DGLPFDA","DGLPIEN","DGLPERR")
+31 KILL DGLPFDA
+32 KILL DGLPERR
+33 ; Clean up after DB call.
DO CLEAN^DILF
+34 SET DGLPRTN=$$FIND1^DIC(100.24,"","QX",DGLPDUZ,"","","DGLPERR")
+35 KILL DGLPERR
+36 ; Clean up after DB call.
DO CLEAN^DILF
End DoDot:1
+37 ;
+38 ; Check - record should now exist in any case:
+39 IF +DGLPRTN<1
WRITE !,"Unable to create an entry for user: "_DGLPDUZ_"!"
QUIT
+40 ;
+41 ; Display title for existing entries:
+42 DO TITLE("Set Default Combination")
+43 WRITE !,$$DASH($SELECT($DATA(IOM):IOM-1,1:78))
+44 WRITE !!," Your current combination entries are:",!
+45 ;
+46 ; Make a call to tag that displays existing entries:
+47 SET DGLPCNT=0
+48 SET DGLPCNT=$$COMBDISP^DGQPTQ5(DGLPDUZ,+DGLPRTN)
+49 IF DGLPCNT=0
WRITE !,"No current combination entries...."
+50 ;
+51 ; Get user's name.
SET DGLPUNM=$PIECE($GET(^VA(200,DGLPDUZ,0)),U,1)
+52 ; Construct title string.
SET DGLPUNM="Setting for user: "_DGLPUNM
+53 SET DGLPCNT=(($SELECT($DATA(IOM):IOM,1:80)-$LENGTH(DGLPUNM))\2)-2
+54 SET DGLPDASH=""
+55 SET $PIECE(DGLPDASH,"-",DGLPCNT+1)=""
+56 ; Write title w/dashes.
WRITE !!,DGLPDASH_" "_DGLPUNM_" "_DGLPDASH
+57 ;
+58 ; Set variables and call DIE to allow user editing of combination:
+59 SET DIE="^OR(100.24,"
+60 SET DA=+DGLPRTN
+61 SET DR="1"
+62 SET DR(.01,100.241)=".01"
+63 DO ^DIE
+64 ;
+65 QUIT
+66 ;
PROC(DGLPT,PARAM) ; Process Parameter Settings
+1 NEW ENT,PAR
+2 DO TITLE(DGLPT)
+3 SET PAR=$ORDER(^XTV(8989.51,"B",PARAM,0))
if PAR=""
QUIT
+4 ; Entity is the user
SET ENT=DUZ_";VA(200,"
+5 WRITE !,$$DASH($SELECT($DATA(IOM):IOM-1,1:78))
+6 DO EDIT^XPAREDIT(ENT,PAR)
+7 QUIT
+8 ;
TITLE(DGBT) ;
+1 ; Center and write title
+2 SET IOP=0
DO ^%ZIS
KILL IOP
WRITE @IOF
+3 WRITE !,?(80-$LENGTH(DGBT)-1/2),DGBT
+4 QUIT
+5 ;
DASH(N) ;extrinsic function returns N dashes
+1 NEW X
+2 SET $PIECE(X,"-",N+1)=""
+3 QUIT X
XCHGPOS ; exchange the users associated with positions/teams
+1 QUIT
