BISITE ;IHS/CMI/MWR - EDIT SITE PARAMETERS; MAY 10, 2010
;;8.5;IMMUNIZATION;;SEP 01,2011
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT SITE PARAMETERS VIA LISTMAN.
;
;
;----------
START ;EP
;---> Lookup and edit a Site.
D SETVARS^BIUTL5
N A,B
D TITLE^BIUTL5("EDIT SITE PARAMETERS") W !
S BIPRMPT=" Select SITE/FACILITY: ",BIDFLT=""
S:$D(DUZ(2)) BIDFLT=$$INSTTX^BIUTL6(DUZ(2))
D DIC^BIFMAN(9002084.02,"QEMAL",.Y,BIPRMPT,BIDFLT)
Q:Y<0
K BIPRMPT,BIDFLT
S BISITE=+Y
L +^BISITE(BISITE):2 I '$T D LOCKED^BIUTL3 Q
D EN(BISITE)
L -^BISITE(BISITE) L -^BISITE(BISITE)
Q
;
;
;----------
EN(BISITE) ;EP
;---> Main entry point for BI SITE PARAMETERS EDIT.
;---> If BISITE not supplied, set Error Code and quit.
I '$G(BISITE) D ERRCD^BIUTL2(109,,1) Q
I '$D(^BISITE(BISITE,0)) D ERRCD^BIUTL2(110,,1) Q
D EN^VALM("BI SITE PARAMETERS EDIT")
Q
;
;
;----------
HDR ;EP
;---> Header code
N X S X=" Edit Site Parameters for: "
S X=X_IOINHI_$$INSTTX^BIUTL6(BISITE)_IOINORM
S VALMHDR(1)=""
S VALMHDR(2)=X
;
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
D INIT^BISITE1
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
S VALMSG="Scroll down to view more Parameters."
D INIT,HDR Q
;
;
;----------
HELP ;EP
;---> Help code.
N BIX S BIX=X
D FULL^VALM1
D TITLE^BIUTL5("SITE PARAMETER SCREEN - HELP")
D TEXT1
D DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
S VALMSG="Scroll down to view more Parameters."
D:BIX'="??" RE^VALM4
Q
;
;
;----------
TEXT1 ;EP
;;This is the screen for editing Site Parameters.
;;
;;To edit a parameter, enter its left column number. Helpful
;;information is presented with each parameter when it is selected.
;;
;;The Site that these parameters applies to is displayed at the top
;;of the screen. This Site is determined when you log on to RPMS.
;;If you are running more than one Site on the same computer and
;;wish to edit parameters for another site, you must log off and
;;log back on under the Site you wish to edit.
;;
D PRINTX("TEXT1")
Q
;
;
;----------
PRINTX(BILINL,BITAB) ;EP
Q:$G(BILINL)=""
N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
F I=1:1 S X=$T(@BILINL+I) Q:X'[";;" W !,T,$P(X,";;",2)
Q
;
;
;----------
EXIT ;EP
;---> EOJ cleanup.
D KILLALL^BIUTL8(1)
K ^TMP("BISITE",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
BISITE ;IHS/CMI/MWR - EDIT SITE PARAMETERS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;;SEP 01,2011
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT SITE PARAMETERS VIA LISTMAN.
+4 ;
+5 ;
+6 ;----------
START ;EP
+1 ;---> Lookup and edit a Site.
+2 DO SETVARS^BIUTL5
+3 NEW A,B
+4 DO TITLE^BIUTL5("EDIT SITE PARAMETERS")
WRITE !
+5 SET BIPRMPT=" Select SITE/FACILITY: "
SET BIDFLT=""
+6 IF $DATA(DUZ(2))
SET BIDFLT=$$INSTTX^BIUTL6(DUZ(2))
+7 DO DIC^BIFMAN(9002084.02,"QEMAL",.Y,BIPRMPT,BIDFLT)
+8 IF Y<0
QUIT
+9 KILL BIPRMPT,BIDFLT
+10 SET BISITE=+Y
+11 LOCK +^BISITE(BISITE):2
IF '$TEST
DO LOCKED^BIUTL3
QUIT
+12 DO EN(BISITE)
+13 LOCK -^BISITE(BISITE)
LOCK -^BISITE(BISITE)
+14 QUIT
+15 ;
+16 ;
+17 ;----------
EN(BISITE) ;EP
+1 ;---> Main entry point for BI SITE PARAMETERS EDIT.
+2 ;---> If BISITE not supplied, set Error Code and quit.
+3 IF '$GET(BISITE)
DO ERRCD^BIUTL2(109,,1)
QUIT
+4 IF '$DATA(^BISITE(BISITE,0))
DO ERRCD^BIUTL2(110,,1)
QUIT
+5 DO EN^VALM("BI SITE PARAMETERS EDIT")
+6 QUIT
+7 ;
+8 ;
+9 ;----------
HDR ;EP
+1 ;---> Header code
+2 NEW X
SET X=" Edit Site Parameters for: "
+3 SET X=X_IOINHI_$$INSTTX^BIUTL6(BISITE)_IOINORM
+4 SET VALMHDR(1)=""
+5 SET VALMHDR(2)=X
+6 ;
+7 QUIT
+8 ;
+9 ;
+10 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 DO INIT^BISITE1
+3 QUIT
+4 ;
+5 ;
+6 ;----------
RESET ;EP
+1 ;---> Update partition for return to Listmanager.
+2 IF $DATA(VALMQUIT)
SET VALMBCK="Q"
QUIT
+3 DO TERM^VALM0
SET VALMBCK="R"
+4 SET VALMSG="Scroll down to view more Parameters."
+5 DO INIT
DO HDR
QUIT
+6 ;
+7 ;
+8 ;----------
HELP ;EP
+1 ;---> Help code.
+2 NEW BIX
SET BIX=X
+3 DO FULL^VALM1
+4 DO TITLE^BIUTL5("SITE PARAMETER SCREEN - HELP")
+5 DO TEXT1
+6 DO DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
+7 SET VALMSG="Scroll down to view more Parameters."
+8 IF BIX'="??"
DO RE^VALM4
+9 QUIT
+10 ;
+11 ;
+12 ;----------
TEXT1 ;EP
+1 ;;This is the screen for editing Site Parameters.
+2 ;;
+3 ;;To edit a parameter, enter its left column number. Helpful
+4 ;;information is presented with each parameter when it is selected.
+5 ;;
+6 ;;The Site that these parameters applies to is displayed at the top
+7 ;;of the screen. This Site is determined when you log on to RPMS.
+8 ;;If you are running more than one Site on the same computer and
+9 ;;wish to edit parameters for another site, you must log off and
+10 ;;log back on under the Site you wish to edit.
+11 ;;
+12 DO PRINTX("TEXT1")
+13 QUIT
+14 ;
+15 ;
+16 ;----------
PRINTX(BILINL,BITAB) ;EP
+1 IF $GET(BILINL)=""
QUIT
+2 NEW I,T,X
SET T=""
IF '$DATA(BITAB)
SET BITAB=5
FOR I=1:1:BITAB
SET T=T_" "
+3 FOR I=1:1
SET X=$TEXT(@BILINL+I)
IF X'[";;"
QUIT
WRITE !,T,$PIECE(X,";;",2)
+4 QUIT
+5 ;
+6 ;
+7 ;----------
EXIT ;EP
+1 ;---> EOJ cleanup.
+2 DO KILLALL^BIUTL8(1)
+3 KILL ^TMP("BISITE",$JOB)
+4 DO CLEAR^VALM1
+5 DO FULL^VALM1
+6 QUIT
