- PSBPAR ;BIRMINGHAM/EFC-BCMA PARAMETER MANAGEMENT ;Mar 2004
- ;;3.0;BAR CODE MED ADMIN;**13,28**;Mar 2004;Build 9
- ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- ;
- EN ; Standard editting of parameters
- K PSBDIV,PSBLIST,DIC
- W !!,"BCMA Parameters Management",!!
- W "You are currently logged onto Division: "_DUZ(2)
- S DIC="^DIC(4,",DIC(0)="AEQM",DIC("A")="Select Division: " D ^DIC Q:+Y<1
- S PSBDIV=+Y_";DIC(4,"
- K DIR S DIR(0)="Y",DIR("A")="Edit Divisional Parameters",DIR("B")="Yes"
- D ^DIR K DIR I Y D TED^XPAREDIT("PSB DIVISION","AB",PSBDIV)
- K DIR S DIR(0)="Y",DIR("A")="Edit Default Lists",DIR("B")="Yes"
- D ^DIR K DIR D:Y
- .S DIR(0)="SO^1:Reasons Given PRN;2:Reasons Held;3:Reasons Refused;4:Injection Sites"
- .S DIR("A")="Select Default List"
- .F W @IOF,!,"BCMA Default Lists",! D ^DIR Q:'Y D
- ..N DIR
- ..I Y=1 D TED^XPAREDIT("PSB LIST REASONS GIVEN PRN","AB",PSBDIV) Q
- ..I Y=2 D TED^XPAREDIT("PSB LIST REASONS HELD","AB",PSBDIV) Q
- ..I Y=3 D TED^XPAREDIT("PSB LIST REASONS REFUSED","AB",PSBDIV) Q
- ..I Y=4 D TED^XPAREDIT("PSB LIST INJECTION SITES","AB",PSBDIV) Q
- Q
- ;
- RPC(RESULTS,PSBCMD,PSBENT,PSBPAR,PSBINS,PSBVAL) ; Main RPC Hit Point
- ;
- ; RPC: PSB PARAMETER
- ;
- ; Description:
- ; Called by client to return or set parameters
- ;
- N PSBERR,PSBTMP
- D:PSBCMD="GETPAR" GETPAR(PSBENT,PSBPAR)
- D:PSBCMD="GETLST" GETLST(PSBENT,PSBPAR)
- D:PSBCMD="SETPAR" SETPAR(PSBENT,PSBPAR,PSBINS,PSBVAL)
- D:PSBCMD="DELLST" DELLST(PSBENT,PSBPAR)
- D:PSBCMD="GETDIV" GETDIV(PSBENT)
- S:'$D(RESULTS) RESULTS(0)="-1^Unknown Internal Error "_PSBCMD
- Q
- ;
- GETDIV(PSBENT) ; Return a valid Entity pointer from user input
- S X=$$FIND1^DIC(4,"","MX",PSBENT)
- I +X<1 S RESULTS(0)="-1^Error, Station # "_PSBENT_" not found." Q
- S RESULTS(0)="1^"_(+X)_";DIC(4,"
- S RESULTS(1)=$$GET1^DIQ(4,+X_",",.01)_" ("_$$GET1^DIQ(4,+X_",",99)_")"
- S RESULTS(2)=$$GET1^DIQ(4,+X_",",1.01)
- S RESULTS(3)=$$GET1^DIQ(4,+X_",",1.02)
- S RESULTS(4)=$$GET1^DIQ(4,+X_",",1.03)
- S RESULTS(5)=$$GET1^DIQ(4,+X_",",.02)
- S RESULTS(6)=$$GET1^DIQ(4,+X_",",1.04)
- S PSBEDIV=+X ;do NOT kill this variable - needed until gui context ends
- Q
- ;
- GETPAR(PSBENT,PSBPAR) ; Return a parameter
- I PSBPAR="PSB 5 RIGHTS IV" S RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"I") Q
- I PSBPAR="PSB 5 RIGHTS UNITDOSE" S RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"I") Q
- S RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"B")
- Q
- ;
- GETLST(PSBENT,PSBPAR) ; Return a parameter list
- D GETLST^XPAR(.PSBTMP,PSBENT,PSBPAR,,.PSBERR)
- I PSBERR S RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$P(PSBERR,"^",2) Q
- S RESULTS(0)=PSBTMP
- F Y=0:0 S Y=$O(PSBTMP(Y)) Q:'Y S RESULTS(Y)=$P(PSBTMP(Y),"^",2)
- Q
- ;
- SETPAR(PSBENT,PSBPAR,PSBINS,PSBVAL) ; Set a new parameter
- D EN^XPAR(PSBENT,PSBPAR,PSBINS,PSBVAL,.PSBERR)
- I 'PSBERR S RESULTS(0)="1^Success"
- E S RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$P(PSBERR,"^",2)
- Q
- ;
- DELLST(PSBENT,PSBPAR) ; Clear a list
- D NDEL^XPAR(PSBENT,PSBPAR,.PSBERR)
- I 'PSBERR S RESULTS(0)="1^Success"
- E S RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$P(PSBERR,"^",2)
- Q
- ;
- USRDEF(PSBPAR) ; Return a parameter for the user
- Q $$GET^XPAR("ALL",PSBPAR)
- ;
- RSTUSR ; Reset all a users parameters
- N PSBUSR,PSBENT,RESULTS
- S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Select User to Reset: "
- D ^DIC K DIC Q:+Y<1 S PSBUSR=+Y
- W !!,"Are you sure you want to reset all parameters for this user"
- S %=2 D YN^DICN Q:%'=1
- W !,"Resetting..."
- S PSBENT=PSBUSR_";VA(200,"
- D DEL^XPAR(PSBENT,"PSB PRINTER USER DEFAULT",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL BLANKS",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL CONT",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL IV MEDS",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL ON-CALL",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL ONE-TIME",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL PRN",1)
- D DEL^XPAR(PSBENT,"PSB VDL INCL UD MEDS",1)
- D DEL^XPAR(PSBENT,"PSB VDL START TIME",1)
- D DEL^XPAR(PSBENT,"PSB VDL STOP TIME",1)
- D DEL^XPAR(PSBENT,"PSB WINDOW",1)
- D DEL^XPAR(PSBENT,"PSB UNIT DOSE COLUMN WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB VDL SORT COLUMN",1)
- D DEL^XPAR(PSBENT,"PSB VDL PB SORT COLUMN",1)
- D DEL^XPAR(PSBENT,"PSB VDL IV SORT COLUMN",1)
- D DEL^XPAR(PSBENT,"PSB IV COLUMN WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB IVPB COLUMN WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB HKEY",1)
- D DEL^XPAR(PSBENT,"PSB IDLE TIMEOUT",1)
- D DEL^XPAR(PSBENT,"PSB GUI DEFAULT PRINTER",1)
- D DEL^XPAR(PSBENT,"PSB COVERSHEET VIEWS COL SORT",1)
- D DEL^XPAR(PSBENT,"PSB COVERSHEET V1 COL WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB COVERSHEET V2 COL WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB COVERSHEET V3 COL WIDTHS",1)
- D DEL^XPAR(PSBENT,"PSB COVERSHEET V4 COL WIDTHS",1)
- W "Done.",!
- Q
- ;
- PSBPAR ;BIRMINGHAM/EFC-BCMA PARAMETER MANAGEMENT ;Mar 2004
- +1 ;;3.0;BAR CODE MED ADMIN;**13,28**;Mar 2004;Build 9
- +2 ;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
- +3 ;
- EN ; Standard editting of parameters
- +1 KILL PSBDIV,PSBLIST,DIC
- +2 WRITE !!,"BCMA Parameters Management",!!
- +3 WRITE "You are currently logged onto Division: "_DUZ(2)
- +4 SET DIC="^DIC(4,"
- SET DIC(0)="AEQM"
- SET DIC("A")="Select Division: "
- DO ^DIC
- IF +Y<1
- QUIT
- +5 SET PSBDIV=+Y_";DIC(4,"
- +6 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Edit Divisional Parameters"
- SET DIR("B")="Yes"
- +7 DO ^DIR
- KILL DIR
- IF Y
- DO TED^XPAREDIT("PSB DIVISION","AB",PSBDIV)
- +8 KILL DIR
- SET DIR(0)="Y"
- SET DIR("A")="Edit Default Lists"
- SET DIR("B")="Yes"
- +9 DO ^DIR
- KILL DIR
- IF Y
- Begin DoDot:1
- +10 SET DIR(0)="SO^1:Reasons Given PRN;2:Reasons Held;3:Reasons Refused;4:Injection Sites"
- +11 SET DIR("A")="Select Default List"
- +12 FOR
- WRITE @IOF,!,"BCMA Default Lists",!
- DO ^DIR
- IF 'Y
- QUIT
- Begin DoDot:2
- +13 NEW DIR
- +14 IF Y=1
- DO TED^XPAREDIT("PSB LIST REASONS GIVEN PRN","AB",PSBDIV)
- QUIT
- +15 IF Y=2
- DO TED^XPAREDIT("PSB LIST REASONS HELD","AB",PSBDIV)
- QUIT
- +16 IF Y=3
- DO TED^XPAREDIT("PSB LIST REASONS REFUSED","AB",PSBDIV)
- QUIT
- +17 IF Y=4
- DO TED^XPAREDIT("PSB LIST INJECTION SITES","AB",PSBDIV)
- QUIT
- End DoDot:2
- End DoDot:1
- +18 QUIT
- +19 ;
- RPC(RESULTS,PSBCMD,PSBENT,PSBPAR,PSBINS,PSBVAL) ; Main RPC Hit Point
- +1 ;
- +2 ; RPC: PSB PARAMETER
- +3 ;
- +4 ; Description:
- +5 ; Called by client to return or set parameters
- +6 ;
- +7 NEW PSBERR,PSBTMP
- +8 IF PSBCMD="GETPAR"
- DO GETPAR(PSBENT,PSBPAR)
- +9 IF PSBCMD="GETLST"
- DO GETLST(PSBENT,PSBPAR)
- +10 IF PSBCMD="SETPAR"
- DO SETPAR(PSBENT,PSBPAR,PSBINS,PSBVAL)
- +11 IF PSBCMD="DELLST"
- DO DELLST(PSBENT,PSBPAR)
- +12 IF PSBCMD="GETDIV"
- DO GETDIV(PSBENT)
- +13 IF '$DATA(RESULTS)
- SET RESULTS(0)="-1^Unknown Internal Error "_PSBCMD
- +14 QUIT
- +15 ;
- GETDIV(PSBENT) ; Return a valid Entity pointer from user input
- +1 SET X=$$FIND1^DIC(4,"","MX",PSBENT)
- +2 IF +X<1
- SET RESULTS(0)="-1^Error, Station # "_PSBENT_" not found."
- QUIT
- +3 SET RESULTS(0)="1^"_(+X)_";DIC(4,"
- +4 SET RESULTS(1)=$$GET1^DIQ(4,+X_",",.01)_" ("_$$GET1^DIQ(4,+X_",",99)_")"
- +5 SET RESULTS(2)=$$GET1^DIQ(4,+X_",",1.01)
- +6 SET RESULTS(3)=$$GET1^DIQ(4,+X_",",1.02)
- +7 SET RESULTS(4)=$$GET1^DIQ(4,+X_",",1.03)
- +8 SET RESULTS(5)=$$GET1^DIQ(4,+X_",",.02)
- +9 SET RESULTS(6)=$$GET1^DIQ(4,+X_",",1.04)
- +10 ;do NOT kill this variable - needed until gui context ends
- SET PSBEDIV=+X
- +11 QUIT
- +12 ;
- GETPAR(PSBENT,PSBPAR) ; Return a parameter
- +1 IF PSBPAR="PSB 5 RIGHTS IV"
- SET RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"I")
- QUIT
- +2 IF PSBPAR="PSB 5 RIGHTS UNITDOSE"
- SET RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"I")
- QUIT
- +3 SET RESULTS(0)=$$GET^XPAR(PSBENT,PSBPAR,,"B")
- +4 QUIT
- +5 ;
- GETLST(PSBENT,PSBPAR) ; Return a parameter list
- +1 DO GETLST^XPAR(.PSBTMP,PSBENT,PSBPAR,,.PSBERR)
- +2 IF PSBERR
- SET RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$PIECE(PSBERR,"^",2)
- QUIT
- +3 SET RESULTS(0)=PSBTMP
- +4 FOR Y=0:0
- SET Y=$ORDER(PSBTMP(Y))
- IF 'Y
- QUIT
- SET RESULTS(Y)=$PIECE(PSBTMP(Y),"^",2)
- +5 QUIT
- +6 ;
- SETPAR(PSBENT,PSBPAR,PSBINS,PSBVAL) ; Set a new parameter
- +1 DO EN^XPAR(PSBENT,PSBPAR,PSBINS,PSBVAL,.PSBERR)
- +2 IF 'PSBERR
- SET RESULTS(0)="1^Success"
- +3 IF '$TEST
- SET RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$PIECE(PSBERR,"^",2)
- +4 QUIT
- +5 ;
- DELLST(PSBENT,PSBPAR) ; Clear a list
- +1 DO NDEL^XPAR(PSBENT,PSBPAR,.PSBERR)
- +2 IF 'PSBERR
- SET RESULTS(0)="1^Success"
- +3 IF '$TEST
- SET RESULTS(0)="-1^Error: "_(+PSBERR)_" "_$PIECE(PSBERR,"^",2)
- +4 QUIT
- +5 ;
- USRDEF(PSBPAR) ; Return a parameter for the user
- +1 QUIT $$GET^XPAR("ALL",PSBPAR)
- +2 ;
- RSTUSR ; Reset all a users parameters
- +1 NEW PSBUSR,PSBENT,RESULTS
- +2 SET DIC="^VA(200,"
- SET DIC(0)="AEQM"
- SET DIC("A")="Select User to Reset: "
- +3 DO ^DIC
- KILL DIC
- IF +Y<1
- QUIT
- SET PSBUSR=+Y
- +4 WRITE !!,"Are you sure you want to reset all parameters for this user"
- +5 SET %=2
- DO YN^DICN
- IF %'=1
- QUIT
- +6 WRITE !,"Resetting..."
- +7 SET PSBENT=PSBUSR_";VA(200,"
- +8 DO DEL^XPAR(PSBENT,"PSB PRINTER USER DEFAULT",1)
- +9 DO DEL^XPAR(PSBENT,"PSB VDL INCL BLANKS",1)
- +10 DO DEL^XPAR(PSBENT,"PSB VDL INCL CONT",1)
- +11 DO DEL^XPAR(PSBENT,"PSB VDL INCL IV MEDS",1)
- +12 DO DEL^XPAR(PSBENT,"PSB VDL INCL ON-CALL",1)
- +13 DO DEL^XPAR(PSBENT,"PSB VDL INCL ONE-TIME",1)
- +14 DO DEL^XPAR(PSBENT,"PSB VDL INCL PRN",1)
- +15 DO DEL^XPAR(PSBENT,"PSB VDL INCL UD MEDS",1)
- +16 DO DEL^XPAR(PSBENT,"PSB VDL START TIME",1)
- +17 DO DEL^XPAR(PSBENT,"PSB VDL STOP TIME",1)
- +18 DO DEL^XPAR(PSBENT,"PSB WINDOW",1)
- +19 DO DEL^XPAR(PSBENT,"PSB UNIT DOSE COLUMN WIDTHS",1)
- +20 DO DEL^XPAR(PSBENT,"PSB VDL SORT COLUMN",1)
- +21 DO DEL^XPAR(PSBENT,"PSB VDL PB SORT COLUMN",1)
- +22 DO DEL^XPAR(PSBENT,"PSB VDL IV SORT COLUMN",1)
- +23 DO DEL^XPAR(PSBENT,"PSB IV COLUMN WIDTHS",1)
- +24 DO DEL^XPAR(PSBENT,"PSB IVPB COLUMN WIDTHS",1)
- +25 DO DEL^XPAR(PSBENT,"PSB HKEY",1)
- +26 DO DEL^XPAR(PSBENT,"PSB IDLE TIMEOUT",1)
- +27 DO DEL^XPAR(PSBENT,"PSB GUI DEFAULT PRINTER",1)
- +28 DO DEL^XPAR(PSBENT,"PSB COVERSHEET VIEWS COL SORT",1)
- +29 DO DEL^XPAR(PSBENT,"PSB COVERSHEET V1 COL WIDTHS",1)
- +30 DO DEL^XPAR(PSBENT,"PSB COVERSHEET V2 COL WIDTHS",1)
- +31 DO DEL^XPAR(PSBENT,"PSB COVERSHEET V3 COL WIDTHS",1)
- +32 DO DEL^XPAR(PSBENT,"PSB COVERSHEET V4 COL WIDTHS",1)
- +33 WRITE "Done.",!
- +34 QUIT
- +35 ;