DGLP3USR.m

DGLP3USR ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97

 ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21

 ;

 ; 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

DGLP3USR  ; SLC/AEB,CLA -User Options - Pt. List Defaults ;9/22/97

 +1       ;;5.3;Registration;**447,1015**;Aug 13, 1993;Build 21

 +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