- BIELIG ;IHS/CMI/MWR - EDIT ELIGIBILITY CODES.; MAY 10, 2010
- ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
- ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- ;; EDIT ELIGIBILITY FIELDS: ACTIVE, LOCAL TEXT, REPORT ABBREVIATION.
- ;; PATCH 3: This entire routine to edit Eligibility Codes is new.
- ;
- ;
- ;----------
- START ;EP
- ;---> Lookup Eligibility Codes and edit their fields.
- D SETVARS^BIUTL5 K ^TMP("BIELIG",$J) N BIELIG,BITMP
- D EN
- D EXIT
- Q
- ;
- ;
- ;----------
- EN ;EP
- D EN^VALM("BI ELIGIBILITY TABLE EDIT")
- Q
- ;
- ;
- ;----------
- PRINT ;EP
- ;---> Print Eligibility Table.
- ;---> Called by Protocol BI VACCINE TABLE PRINT, which is the
- ;---> Print List Protocol for the List: BI VACCINE TABLE EDIT.
- ;
- D DEVICE(.BIPOP)
- I $G(BIPOP) D RESET Q
- ;
- D HDR(1),INIT^BIELIG1
- D PRTLST^BIUTL8("BIELIG")
- D RESET
- Q
- ;
- ;
- ;----------
- HDR(BIPRT) ;EP
- ;---> Header code for both Listman Screen and Print List.
- ;---> Parameters:
- ; 1 - BIPRT (opt) If BIPRT=1 array is for print: Change column
- ; header line and add Site Header line.
- ;
- N BILINE,X,Y S BILINE=0 K VALMHDR
- N BICRT S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
- ;
- D WH^BIW(.BILINE)
- S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
- D WH^BIW(.BILINE,X)
- S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
- D WH^BIW(.BILINE,X)
- ;
- S X="ELIGIBILITY CODE TABLE" S:'$G(BIPRT) X="EDIT "_X D CENTERT^BIUTL5(.X)
- S:BICRT X=IOINHI_X_IOINORM
- D WH^BIW(.BILINE,X)
- ;
- D:$G(BIPRT)
- .S X=$$SP^BIUTL5(51)_"Printed: "_$$NOW^BIUTL5()
- .D WH^BIW(.BILINE,X,1)
- .S X=" # Eligibility Code Label of Cdoe Status Local Text Report Text"
- .D WH^BIW(.BILINE,X)
- Q
- ;
- ;
- ;----------
- INIT ;EP
- ;---> Initialize variables and list array.
- D INIT^BIELIG1
- Q
- ;
- ;
- ;----------
- RESET ;EP
- ;---> Update partition for return to Listmanager.
- I $D(VALMQUIT) S VALMBCK="Q" Q
- D TERM^VALM0 S VALMBCK="R"
- D INIT,HDR() Q
- ;
- ;
- ;----------
- DEVICE(BIPOP) ;EP
- ;---> Get Device and possibly queue to Taskman.
- ;---> Parameters:
- ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
- ;
- K %ZIS,IOP S BIPOP=0
- S ZTRTN="DEQUEUE^BIELIG"
- D ZSAVES^BIUTL3
- D ZIS^BIUTL2(.BIPOP,1)
- Q
- ;
- ;
- ;----------
- DEQUEUE ;EP
- ;---> Print Patient Data screen.
- D HDR(1),INIT^BIELIG1
- D PRTLST^BIUTL8("BIELIG"),EXIT
- Q
- ;
- ;
- ;----------
- HELP ;EP
- ;---> Help code.
- N BIX S BIX=X
- D FULL^VALM1
- W !!?5,"Enter ""E"" to edit a Eligibility Code, enter ""C"" to change the order of"
- W !?5,"the list, ""H"" to view the full help text for the Eligibility list and"
- W !?5,"its parameters, ""F"" to turn on/off the forecasting of vaccines"
- W !?5,"and enter ""P"" to print the list."
- D DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
- D:BIX'="??" RE^VALM4
- Q
- ;
- ;
- ;----------
- HELP1 ;EP
- ;----> Explanation of this report.
- N BITEXT D TEXT1(.BITEXT)
- D START^BIHELP("EDIT VACCINE TABLE - HELP",.BITEXT)
- Q
- ;
- ;
- ;----------
- TEXT1(BITEXT) ;EP
- ;;
- ;;This screen allows you to edit 3 fields for each Eligibility Code.
- ;;To Edit a particular Code, type "E", then select the left
- ;;column number that corresponds to the Code you wish to edit.
- ;;
- ;;* Active/Inactive - If a Code is set to "Inactive", users will
- ;; not be able to select this Elligibility Code when entering or
- ;; editing immunizations. However, previous immunizations with
- ;; Code will continue to display it.
- ;;
- ;;* Local Text - This is an optional, locally meaningful text that
- ;; may be entered to help staff recognize Codes. It may be the
- ;; proper name of a local or State program, a regional or clinic
- ;; name, or whatever is helpful. It may be up to 20 characters
- ;; in length. It is not exported, nor does it appear anywhere
- ;; except during the Eligibility Code selection (along side the
- ;; true Code) when immunizations are entered or edited.
- ;;
- ;;* Report Abbreviation - This is an optional, locally meaningful text
- ;; that can be entered to help make information in the Eligibility
- ;; Report more recognizable. Text entered here will show up in
- ;; the fourth column of the Vaccine Eligibility Report. (If no Report
- ;; Abbreviation has been entered, then the standard Eligibility Code
- ;; will appear in column four of the report.)
- ;;
- D LOADTX("TEXT1",,.BITEXT)
- Q
- ;
- ;
- ;----------
- LOADTX(BILINL,BITAB,BITEXT) ;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'[";;" S BITEXT(I)=T_$P(X,";;",2)
- Q
- ;
- ;
- ;----------
- EXIT ;EP
- ;---> End of job cleanup.
- D KILLALL^BIUTL8()
- K ^TMP("BIELIG",$J)
- D CLEAR^VALM1
- D FULL^VALM1
- Q
- ;
- ;
- ;----------
- ELIGC(IEN,FORM) ;EP
- ;---> Return Eligibility values from BI TABLE ELIGIBILITY CODES File.
- ;---> Parameters:
- ; 1 - IEN (req) IEN of Elig Code.
- ; 2 - FORM (opt) FORM of Code to return:
- ; 1=Actual Code (also default)
- ; 2=Label Text of Code
- ; 3=Active/Inactive Status (1
- ; 4=Local Text
- ; 5=Local Report Abbreviation
- ;
- Q:'$G(IEN) ""
- Q:'$D(^BIELIG(IEN,0)) "NO GLOBAL"
- N Y S Y=^BIELIG(IEN,0)
- ;
- Q:$G(FORM)=2 $P(Y,U,2)
- Q:$G(FORM)=3 $P(Y,U,3)
- Q:$G(FORM)=4 $P(Y,U,4)
- Q:$G(FORM)=5 $P(Y,U,5)
- Q:$G(FORM)=6 $S($P(Y,U,5)]"":$P(Y,U,5),1:$P(Y,U))
- Q $P(Y,U)
- BIELIG ;IHS/CMI/MWR - EDIT ELIGIBILITY CODES.; MAY 10, 2010
- +1 ;;8.5;IMMUNIZATION;**3**;SEP 10,2012
- +2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
- +3 ;; EDIT ELIGIBILITY FIELDS: ACTIVE, LOCAL TEXT, REPORT ABBREVIATION.
- +4 ;; PATCH 3: This entire routine to edit Eligibility Codes is new.
- +5 ;
- +6 ;
- +7 ;----------
- START ;EP
- +1 ;---> Lookup Eligibility Codes and edit their fields.
- +2 DO SETVARS^BIUTL5
- KILL ^TMP("BIELIG",$JOB)
- NEW BIELIG,BITMP
- +3 DO EN
- +4 DO EXIT
- +5 QUIT
- +6 ;
- +7 ;
- +8 ;----------
- EN ;EP
- +1 DO EN^VALM("BI ELIGIBILITY TABLE EDIT")
- +2 QUIT
- +3 ;
- +4 ;
- +5 ;----------
- PRINT ;EP
- +1 ;---> Print Eligibility Table.
- +2 ;---> Called by Protocol BI VACCINE TABLE PRINT, which is the
- +3 ;---> Print List Protocol for the List: BI VACCINE TABLE EDIT.
- +4 ;
- +5 DO DEVICE(.BIPOP)
- +6 IF $GET(BIPOP)
- DO RESET
- QUIT
- +7 ;
- +8 DO HDR(1)
- DO INIT^BIELIG1
- +9 DO PRTLST^BIUTL8("BIELIG")
- +10 DO RESET
- +11 QUIT
- +12 ;
- +13 ;
- +14 ;----------
- HDR(BIPRT) ;EP
- +1 ;---> Header code for both Listman Screen and Print List.
- +2 ;---> Parameters:
- +3 ; 1 - BIPRT (opt) If BIPRT=1 array is for print: Change column
- +4 ; header line and add Site Header line.
- +5 ;
- +6 NEW BILINE,X,Y
- SET BILINE=0
- KILL VALMHDR
- +7 NEW BICRT
- SET BICRT=$SELECT(($EXTRACT($GET(IOST))="C")!(IOST["BROWSER"):1,1:0)
- +8 ;
- +9 DO WH^BIW(.BILINE)
- +10 SET X=$$REPHDR^BIUTL6(DUZ(2))
- SET BIDASH=$LENGTH(X)+2
- DO CENTERT^BIUTL5(.X)
- +11 DO WH^BIW(.BILINE,X)
- +12 SET X=$$SP^BIUTL5(BIDASH,"-")
- DO CENTERT^BIUTL5(.X)
- +13 DO WH^BIW(.BILINE,X)
- +14 ;
- +15 SET X="ELIGIBILITY CODE TABLE"
- IF '$GET(BIPRT)
- SET X="EDIT "_X
- DO CENTERT^BIUTL5(.X)
- +16 IF BICRT
- SET X=IOINHI_X_IOINORM
- +17 DO WH^BIW(.BILINE,X)
- +18 ;
- +19 IF $GET(BIPRT)
- Begin DoDot:1
- +20 SET X=$$SP^BIUTL5(51)_"Printed: "_$$NOW^BIUTL5()
- +21 DO WH^BIW(.BILINE,X,1)
- +22 SET X=" # Eligibility Code Label of Cdoe Status Local Text Report Text"
- +23 DO WH^BIW(.BILINE,X)
- End DoDot:1
- +24 QUIT
- +25 ;
- +26 ;
- +27 ;----------
- INIT ;EP
- +1 ;---> Initialize variables and list array.
- +2 DO INIT^BIELIG1
- +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 DO INIT
- DO HDR()
- QUIT
- +5 ;
- +6 ;
- +7 ;----------
- DEVICE(BIPOP) ;EP
- +1 ;---> Get Device and possibly queue to Taskman.
- +2 ;---> Parameters:
- +3 ; 1 - BIPOP (ret) If error or Queue, BIPOP=1
- +4 ;
- +5 KILL %ZIS,IOP
- SET BIPOP=0
- +6 SET ZTRTN="DEQUEUE^BIELIG"
- +7 DO ZSAVES^BIUTL3
- +8 DO ZIS^BIUTL2(.BIPOP,1)
- +9 QUIT
- +10 ;
- +11 ;
- +12 ;----------
- DEQUEUE ;EP
- +1 ;---> Print Patient Data screen.
- +2 DO HDR(1)
- DO INIT^BIELIG1
- +3 DO PRTLST^BIUTL8("BIELIG")
- DO EXIT
- +4 QUIT
- +5 ;
- +6 ;
- +7 ;----------
- HELP ;EP
- +1 ;---> Help code.
- +2 NEW BIX
- SET BIX=X
- +3 DO FULL^VALM1
- +4 WRITE !!?5,"Enter ""E"" to edit a Eligibility Code, enter ""C"" to change the order of"
- +5 WRITE !?5,"the list, ""H"" to view the full help text for the Eligibility list and"
- +6 WRITE !?5,"its parameters, ""F"" to turn on/off the forecasting of vaccines"
- +7 WRITE !?5,"and enter ""P"" to print the list."
- +8 DO DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
- +9 IF BIX'="??"
- DO RE^VALM4
- +10 QUIT
- +11 ;
- +12 ;
- +13 ;----------
- HELP1 ;EP
- +1 ;----> Explanation of this report.
- +2 NEW BITEXT
- DO TEXT1(.BITEXT)
- +3 DO START^BIHELP("EDIT VACCINE TABLE - HELP",.BITEXT)
- +4 QUIT
- +5 ;
- +6 ;
- +7 ;----------
- TEXT1(BITEXT) ;EP
- +1 ;;
- +2 ;;This screen allows you to edit 3 fields for each Eligibility Code.
- +3 ;;To Edit a particular Code, type "E", then select the left
- +4 ;;column number that corresponds to the Code you wish to edit.
- +5 ;;
- +6 ;;* Active/Inactive - If a Code is set to "Inactive", users will
- +7 ;; not be able to select this Elligibility Code when entering or
- +8 ;; editing immunizations. However, previous immunizations with
- +9 ;; Code will continue to display it.
- +10 ;;
- +11 ;;* Local Text - This is an optional, locally meaningful text that
- +12 ;; may be entered to help staff recognize Codes. It may be the
- +13 ;; proper name of a local or State program, a regional or clinic
- +14 ;; name, or whatever is helpful. It may be up to 20 characters
- +15 ;; in length. It is not exported, nor does it appear anywhere
- +16 ;; except during the Eligibility Code selection (along side the
- +17 ;; true Code) when immunizations are entered or edited.
- +18 ;;
- +19 ;;* Report Abbreviation - This is an optional, locally meaningful text
- +20 ;; that can be entered to help make information in the Eligibility
- +21 ;; Report more recognizable. Text entered here will show up in
- +22 ;; the fourth column of the Vaccine Eligibility Report. (If no Report
- +23 ;; Abbreviation has been entered, then the standard Eligibility Code
- +24 ;; will appear in column four of the report.)
- +25 ;;
- +26 DO LOADTX("TEXT1",,.BITEXT)
- +27 QUIT
- +28 ;
- +29 ;
- +30 ;----------
- LOADTX(BILINL,BITAB,BITEXT) ;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
- SET BITEXT(I)=T_$PIECE(X,";;",2)
- +4 QUIT
- +5 ;
- +6 ;
- +7 ;----------
- EXIT ;EP
- +1 ;---> End of job cleanup.
- +2 DO KILLALL^BIUTL8()
- +3 KILL ^TMP("BIELIG",$JOB)
- +4 DO CLEAR^VALM1
- +5 DO FULL^VALM1
- +6 QUIT
- +7 ;
- +8 ;
- +9 ;----------
- ELIGC(IEN,FORM) ;EP
- +1 ;---> Return Eligibility values from BI TABLE ELIGIBILITY CODES File.
- +2 ;---> Parameters:
- +3 ; 1 - IEN (req) IEN of Elig Code.
- +4 ; 2 - FORM (opt) FORM of Code to return:
- +5 ; 1=Actual Code (also default)
- +6 ; 2=Label Text of Code
- +7 ; 3=Active/Inactive Status (1
- +8 ; 4=Local Text
- +9 ; 5=Local Report Abbreviation
- +10 ;
- +11 IF '$GET(IEN)
- QUIT ""
- +12 IF '$DATA(^BIELIG(IEN,0))
- QUIT "NO GLOBAL"
- +13 NEW Y
- SET Y=^BIELIG(IEN,0)
- +14 ;
- +15 IF $GET(FORM)=2
- QUIT $PIECE(Y,U,2)
- +16 IF $GET(FORM)=3
- QUIT $PIECE(Y,U,3)
- +17 IF $GET(FORM)=4
- QUIT $PIECE(Y,U,4)
- +18 IF $GET(FORM)=5
- QUIT $PIECE(Y,U,5)
- +19 IF $GET(FORM)=6
- QUIT $SELECT($PIECE(Y,U,5)]"":$PIECE(Y,U,5),1:$PIECE(Y,U))
- +20 QUIT $PIECE(Y,U)
