- 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
