ORLP3USR.m

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

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