ORLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97 [9/12/00 12:17pm]
;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,82**;Dec 17, 1997
;
; SLC/PKS - Modifications for "combinations" - 3/2000.
;
CLSTRTD ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Start Date",PARAM="ORLP DEFAULT CLINIC START DATE"
D PROC(ORLPT,PARAM)
Q
CLSTPD ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Stop Date",PARAM="ORLP DEFAULT CLINIC STOP DATE"
D PROC(ORLPT,PARAM)
Q
CLSUN ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Sunday",PARAM="ORLP DEFAULT CLINIC SUNDAY"
D PROC(ORLPT,PARAM)
Q
CLMON ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Monday",PARAM="ORLP DEFAULT CLINIC MONDAY"
D PROC(ORLPT,PARAM)
Q
CLTUE ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Tuesday",PARAM="ORLP DEFAULT CLINIC TUESDAY"
D PROC(ORLPT,PARAM)
Q
CLWED ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Wednesday",PARAM="ORLP DEFAULT CLINIC WEDNESDAY"
D PROC(ORLPT,PARAM)
Q
CLTHUR ;
N ORLPT,PARAM
S ORLPT="Set Defalt Clinic Thursday",PARAM="ORLP DEFAULT CLINIC THURSDAY"
D PROC(ORLPT,PARAM)
Q
CLFRI ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Friday",PARAM="ORLP DEFAULT CLINIC FRIDAY"
D PROC(ORLPT,PARAM)
Q
CLSAT ;
N ORLPT,PARAM
S ORLPT="Set Default Clinic Saturday",PARAM="ORLP DEFAULT CLINIC SATURDAY"
D PROC(ORLPT,PARAM)
Q
LSTORD ;
N ORLPT,PARAM
S ORLPT="Set Default Sort Order for Patient List",PARAM="ORLP DEFAULT LIST ORDER"
D PROC(ORLPT,PARAM)
Q
LSTSRC ;
N ORLPT,PARAM
S ORLPT="Set Default List Source",PARAM="ORLP DEFAULT LIST SOURCE"
D PROC(ORLPT,PARAM)
Q
PROVIDER ;
N ORLPT,PARAM
S ORLPT="Set Default Primary Provider",PARAM="ORLP DEFAULT PROVIDER"
D PROC(ORLPT,PARAM)
Q
SPEC ;
N ORLPT,PARAM
S ORLPT="Set Default Treating Specialty",PARAM="ORLP DEFAULT SPECIALTY"
D PROC(ORLPT,PARAM)
Q
TEAM ;
N ORLPT,PARAM
S ORLPT="Set Default Team List",PARAM="ORLP DEFAULT TEAM"
D PROC(ORLPT,PARAM)
Q
WARD ;
N ORLPT,PARAM
S ORLPT="Set Default Ward",PARAM="ORLP DEFAULT WARD"
D PROC(ORLPT,PARAM)
Q
;
COMB ; Set default combination sources.
; SLC/PKS - 3/2000
;
; Variables used:
;
; DA,DIE,DR = DIE variables.
; ORLPCNT = Holds return value from function call.
; ORLPDASH = Screen "-" character write holder.
; ORLPDUZ = DUZ of current user.
; ORLPERR = Error array for return by DB calls.
; ORLPFDA = Namespaced required DB call variable.
; ORLPIEN = Array for DB call.
; ORLPRTN = Holds value returned by DB calls.
; ORLPUNM = Name of current user from ^VA(200, file.
;
N DA,DIE,DR,ORLPCNT,ORLPDASH,ORLPDUZ,ORLPERR,ORLPFDA,ORLPIEN,ORLPRTN,ORLPUNM
;
; Find existing record for this user:
I '$D(DUZ) W !,"No user DUZ info." Q
S ORLPDUZ=DUZ
K ORLPERR
S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
K ORLPERR
D CLEAN^DILF ; Clean up after DB call.
;
; Create a record if one does not exist:
I ORLPRTN<1 D
.K ORLPERR
.S ORLPFDA(100.24,"+1,",.01)=ORLPDUZ
.S ORLPIEN(1)=ORLPDUZ ; Set up for DINUM record insertion.
.D UPDATE^DIE("S","ORLPFDA","ORLPIEN","ORLPERR")
.K ORLPFDA
.K ORLPERR
.D CLEAN^DILF ; Clean up after DB call.
.S ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
.K ORLPERR
.D CLEAN^DILF ; Clean up after DB call.
;
; Check - record should now exist in any case:
I +ORLPRTN<1 W !,"Unable to create an entry for user: "_ORLPDUZ_"!" 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 ORLPCNT=0
S ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,+ORLPRTN)
I ORLPCNT=0 W !,"No current combination entries...."
;
S ORLPUNM=$P($G(^VA(200,ORLPDUZ,0)),U,1) ; Get user's name.
S ORLPUNM="Setting for user: "_ORLPUNM ; Construct title string.
S ORLPCNT=(($S($D(IOM):IOM,1:80)-$L(ORLPUNM))\2)-2
S ORLPDASH=""
S $P(ORLPDASH,"-",ORLPCNT+1)=""
W !!,ORLPDASH_" "_ORLPUNM_" "_ORLPDASH ; Write title w/dashes.
;
; Set variables and call DIE to allow user editing of combination:
S DIE="^OR(100.24,"
S DA=+ORLPRTN
S DR="1"
S DR(.01,100.241)=".01"
D ^DIE
;
Q
;
PROC(ORLPT,PARAM) ; Process Parameter Settings
N ENT,PAR
D TITLE(ORLPT)
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(ORBT) ;
; Center and write title
S IOP=0 D ^%ZIS K IOP W @IOF
W !,?(80-$L(ORBT)-1/2),ORBT
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[HORLP3USR 4795 printed Apr 09, 2024@21:40:30 Page 2
ORLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97 [9/12/00 12:17pm]
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**9,82**;Dec 17, 1997
+2 ;
+3 ; SLC/PKS - Modifications for "combinations" - 3/2000.
+4 ;
CLSTRTD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Start Date"
SET PARAM="ORLP DEFAULT CLINIC START DATE"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLSTPD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Stop Date"
SET PARAM="ORLP DEFAULT CLINIC STOP DATE"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLSUN ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Sunday"
SET PARAM="ORLP DEFAULT CLINIC SUNDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLMON ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Monday"
SET PARAM="ORLP DEFAULT CLINIC MONDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLTUE ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Tuesday"
SET PARAM="ORLP DEFAULT CLINIC TUESDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLWED ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Wednesday"
SET PARAM="ORLP DEFAULT CLINIC WEDNESDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLTHUR ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Defalt Clinic Thursday"
SET PARAM="ORLP DEFAULT CLINIC THURSDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLFRI ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Friday"
SET PARAM="ORLP DEFAULT CLINIC FRIDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
CLSAT ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Clinic Saturday"
SET PARAM="ORLP DEFAULT CLINIC SATURDAY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
LSTORD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Sort Order for Patient List"
SET PARAM="ORLP DEFAULT LIST ORDER"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
LSTSRC ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default List Source"
SET PARAM="ORLP DEFAULT LIST SOURCE"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
PROVIDER ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Primary Provider"
SET PARAM="ORLP DEFAULT PROVIDER"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
SPEC ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Treating Specialty"
SET PARAM="ORLP DEFAULT SPECIALTY"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
TEAM ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Team List"
SET PARAM="ORLP DEFAULT TEAM"
+3 DO PROC(ORLPT,PARAM)
+4 QUIT
WARD ;
+1 NEW ORLPT,PARAM
+2 SET ORLPT="Set Default Ward"
SET PARAM="ORLP DEFAULT WARD"
+3 DO PROC(ORLPT,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 ; ORLPCNT = Holds return value from function call.
+7 ; ORLPDASH = Screen "-" character write holder.
+8 ; ORLPDUZ = DUZ of current user.
+9 ; ORLPERR = Error array for return by DB calls.
+10 ; ORLPFDA = Namespaced required DB call variable.
+11 ; ORLPIEN = Array for DB call.
+12 ; ORLPRTN = Holds value returned by DB calls.
+13 ; ORLPUNM = Name of current user from ^VA(200, file.
+14 ;
+15 NEW DA,DIE,DR,ORLPCNT,ORLPDASH,ORLPDUZ,ORLPERR,ORLPFDA,ORLPIEN,ORLPRTN,ORLPUNM
+16 ;
+17 ; Find existing record for this user:
+18 IF '$DATA(DUZ)
WRITE !,"No user DUZ info."
QUIT
+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 ; Create a record if one does not exist:
+26 IF ORLPRTN<1
Begin DoDot:1
+27 KILL ORLPERR
+28 SET ORLPFDA(100.24,"+1,",.01)=ORLPDUZ
+29 ; Set up for DINUM record insertion.
SET ORLPIEN(1)=ORLPDUZ
+30 DO UPDATE^DIE("S","ORLPFDA","ORLPIEN","ORLPERR")
+31 KILL ORLPFDA
+32 KILL ORLPERR
+33 ; Clean up after DB call.
DO CLEAN^DILF
+34 SET ORLPRTN=$$FIND1^DIC(100.24,"","QX",ORLPDUZ,"","","ORLPERR")
+35 KILL ORLPERR
+36 ; Clean up after DB call.
DO CLEAN^DILF
End DoDot:1
+37 ;
+38 ; Check - record should now exist in any case:
+39 IF +ORLPRTN<1
WRITE !,"Unable to create an entry for user: "_ORLPDUZ_"!"
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 ORLPCNT=0
+48 SET ORLPCNT=$$COMBDISP^ORQPTQ5(ORLPDUZ,+ORLPRTN)
+49 IF ORLPCNT=0
WRITE !,"No current combination entries...."
+50 ;
+51 ; Get user's name.
SET ORLPUNM=$PIECE($GET(^VA(200,ORLPDUZ,0)),U,1)
+52 ; Construct title string.
SET ORLPUNM="Setting for user: "_ORLPUNM
+53 SET ORLPCNT=(($SELECT($DATA(IOM):IOM,1:80)-$LENGTH(ORLPUNM))\2)-2
+54 SET ORLPDASH=""
+55 SET $PIECE(ORLPDASH,"-",ORLPCNT+1)=""
+56 ; Write title w/dashes.
WRITE !!,ORLPDASH_" "_ORLPUNM_" "_ORLPDASH
+57 ;
+58 ; Set variables and call DIE to allow user editing of combination:
+59 SET DIE="^OR(100.24,"
+60 SET DA=+ORLPRTN
+61 SET DR="1"
+62 SET DR(.01,100.241)=".01"
+63 DO ^DIE
+64 ;
+65 QUIT
+66 ;
PROC(ORLPT,PARAM) ; Process Parameter Settings
+1 NEW ENT,PAR
+2 DO TITLE(ORLPT)
+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(ORBT) ;
+1 ; Center and write title
+2 SET IOP=0
DO ^%ZIS
KILL IOP
WRITE @IOF
+3 WRITE !,?(80-$LENGTH(ORBT)-1/2),ORBT
+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
