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)
