BINDC ;IHS/CMI/MWR - EDIT NDC CODES.; MAY 10, 2010
;;8.5;IMMUNIZATION;**9**;OCT 01,2014
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT NDC NUMBER FIELDS.
; PATCH 2: Redisplay Message area (with # of NDCs) in List Template. HELP+5
;
;
;
;----------
START ;EP
;---> Lookup NDC CODES and edit their fields. vvv83
D SETVARS^BIUTL5 K ^TMP("BINDC",$J) N BICOLL,BISUBT,BITMP,BIINACT
S BISUBT="1:NDC Code;2:Vaccine Name, then by NDC Code"
;S BISUBT=BISUBT_";5:Vaccine Name, then by Exp Date"
;
;---> If Vaccine Table is not standard, display Error Text and quit.
I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
;
D EN
D EXIT
Q
;
;
;----------
EN ;EP
D EN^VALM("BI NDC TABLE EDIT")
Q
;
;
;----------
PRINT ;EP
;---> Print NDC Number Table.
;---> Called by Protocol BI NDC NUMBER TABLE PRINT, which is the
;---> Print List Protocol for the List: BI NDC NUMBER TABLE EDIT.
;
D DEVICE(.BIPOP)
I $G(BIPOP) D RESET Q
;
D HDR(1),INIT^BINDC1
D PRTLST^BIUTL8("BINDC")
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="NDC NUMBER TABLE" S:'$G(BIPRT) X="EDIT "_X
D CENTERT^BIUTL5(.X)
S:BICRT X=IOINHI_X_IOINORM
D WH^BIW(.BILINE,X)
;
;---> Subtitle: indicate order of listing.
D:($G(BICOLL)&$D(BISUBT))
.N Y S Y=$P($P(BISUBT,BICOLL_":",2),";") S X=" (Listed by "_Y_")"
.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=" # NDC Code Vaccine CVX Manufacturer Product Status"
.D WH^BIW(.BILINE,X)
Q
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
D INIT^BINDC1
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^BINDC"
D ZSAVES^BIUTL3
D ZIS^BIUTL2(.BIPOP,1)
Q
;
;
;----------
DEQUEUE ;EP
;---> Print Patient Data screen.
D HDR(1),INIT^BINDC1
D PRTLST^BIUTL8("BINDC"),EXIT
Q
;
;
;----------
HELP ;EP
;---> Help code.
N BIX S BIX=X
D FULL^VALM1
W !!?5,"Enter ""A"" to add or edit an NDC Code, enter ""E"" to select and Edit an"
W !?5,"NDC Code from the left column, enter ""C"" to change the order of the list,"
W !?5,"""S"" to Search for a particular NDC Code, ""D"" to include NDC Codes"
W !?5,"in the display (will appear after all Active Lot Numbers),and enter ""H"""
W !?5,"to view the full help text for the NDC list and its parameters."
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 NDC CODES - HELP",.BITEXT)
;
;---> Redisplay Message area (with number of NDCs) in List Template.
D RESET^BINDC1
Q
;
; vvv83
;----------
TEXT1(BITEXT) ;EP
;;
;;This screen allows you to view and edit the fields of NDC CODES.
;;
;;NOTE: To show INACTIVE NDC CODES, select "D Display Inactives."
;;
;;To Add a new NDC Number, type "A". If the NDC Number already exists in
;;the Table, a message will display, directng you select that NDC Number
;;for editing.
;;
;;To edit an existing NDC Number type "E" and then select the left column
;;number that corresponds to the NDC Number you wish to edit.
;;
;;You may also SEARCH the entire list for any number, name, or combination
;;of characters by usinng the "S Search List" action.
;;
;;You may list the NDCs by either NDC Code or Vaccine (alphabetically) using
;;the Change List Order action.
;;
;;
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
;
;
;----------
TEXT3 ;EP
;;
;;This option will automatically INACTIVATE ALL NDC CODES that
;;have EXPIRED (an Expiration Date prior to today).
;;
;;It will also automatically INACTIVATE ALL NDC CODES that have
;;NO Expiration Date (as viewed in the NDC Number Table).
;;
;; Note: You can REACTIVATE any NDC Number individually at any time
;; by editing the NDC Number individually from the Edit NDC CODES
;; Screen (and resetting the Active Field for that NDC Number).
;;
;;Do you wish to INACTIVATE ALL NDC CODES that either have EXPIRED
;;or have NO Expiration Date?
;;
D PRINTX("TEXT3")
Q
;
;
;----------
TEXT33 ;EP
;;
;;Okay.
;;Please confirm that you wish Inactivate all NDC CODES that
;;either have EXPIRED or have NO Expiration Eate, by typing "YES"
;;a second time. (Enter NO to discontinue this process.)
;;
D PRINTX("TEXT33")
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
;---> End of job cleanup.
D KILLALL^BIUTL8()
K ^TMP("BINDC",$J)
D CLEAR^VALM1
D FULL^VALM1
Q
;
;
;----------
NDC(IEN,FORM) ;EP
;---> Return NDC Code values from BI TABLE NDC CODES File.
;---> Parameters:
; 1 - IEN (req) IEN of NDC Code.
; 2 - FORM (opt) FORM of Code to return:
; 1=Actual NDC Code (also default)
; 2=Vaccine Pointer (use for Vaccine Name or CVX)
; 3=Manufacturer Pointer
; 4=Product Name
; 5=Status
;
Q:'$G(IEN) ""
Q:'$D(^BINDC(IEN,0)) "NO GLOBAL"
N Y S Y=^BINDC(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 $P(Y,U)
BINDC ;IHS/CMI/MWR - EDIT NDC CODES.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT NDC NUMBER FIELDS.
+4 ; PATCH 2: Redisplay Message area (with # of NDCs) in List Template. HELP+5
+5 ;
+6 ;
+7 ;
+8 ;----------
START ;EP
+1 ;---> Lookup NDC CODES and edit their fields. vvv83
+2 DO SETVARS^BIUTL5
KILL ^TMP("BINDC",$JOB)
NEW BICOLL,BISUBT,BITMP,BIINACT
+3 SET BISUBT="1:NDC Code;2:Vaccine Name, then by NDC Code"
+4 ;S BISUBT=BISUBT_";5:Vaccine Name, then by Exp Date"
+5 ;
+6 ;---> If Vaccine Table is not standard, display Error Text and quit.
+7 IF $DATA(^BISITE(-1))
DO ERRCD^BIUTL2(503,,1)
QUIT
+8 ;
+9 DO EN
+10 DO EXIT
+11 QUIT
+12 ;
+13 ;
+14 ;----------
EN ;EP
+1 DO EN^VALM("BI NDC TABLE EDIT")
+2 QUIT
+3 ;
+4 ;
+5 ;----------
PRINT ;EP
+1 ;---> Print NDC Number Table.
+2 ;---> Called by Protocol BI NDC NUMBER TABLE PRINT, which is the
+3 ;---> Print List Protocol for the List: BI NDC NUMBER TABLE EDIT.
+4 ;
+5 DO DEVICE(.BIPOP)
+6 IF $GET(BIPOP)
DO RESET
QUIT
+7 ;
+8 DO HDR(1)
DO INIT^BINDC1
+9 DO PRTLST^BIUTL8("BINDC")
+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="NDC NUMBER TABLE"
IF '$GET(BIPRT)
SET X="EDIT "_X
+16 DO CENTERT^BIUTL5(.X)
+17 IF BICRT
SET X=IOINHI_X_IOINORM
+18 DO WH^BIW(.BILINE,X)
+19 ;
+20 ;---> Subtitle: indicate order of listing.
+21 IF ($GET(BICOLL)&$DATA(BISUBT))
Begin DoDot:1
+22 NEW Y
SET Y=$PIECE($PIECE(BISUBT,BICOLL_":",2),";")
SET X=" (Listed by "_Y_")"
+23 DO CENTERT^BIUTL5(.X)
IF BICRT
SET X=IOINHI_X_IOINORM
DO WH^BIW(.BILINE,X)
End DoDot:1
+24 ;
+25 IF $GET(BIPRT)
Begin DoDot:1
+26 SET X=$$SP^BIUTL5(51)_"Printed: "_$$NOW^BIUTL5()
+27 DO WH^BIW(.BILINE,X,1)
+28 SET X=" # NDC Code Vaccine CVX Manufacturer Product Status"
+29 DO WH^BIW(.BILINE,X)
End DoDot:1
+30 QUIT
+31 ;
+32 ;
+33 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 DO INIT^BINDC1
+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^BINDC"
+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^BINDC1
+3 DO PRTLST^BIUTL8("BINDC")
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 ""A"" to add or edit an NDC Code, enter ""E"" to select and Edit an"
+5 WRITE !?5,"NDC Code from the left column, enter ""C"" to change the order of the list,"
+6 WRITE !?5,"""S"" to Search for a particular NDC Code, ""D"" to include NDC Codes"
+7 WRITE !?5,"in the display (will appear after all Active Lot Numbers),and enter ""H"""
+8 WRITE !?5,"to view the full help text for the NDC list and its parameters."
+9 DO DIRZ^BIUTL3(""," Press ENTER/RETURN to continue")
+10 IF BIX'="??"
DO RE^VALM4
+11 QUIT
+12 ;
+13 ;
+14 ;----------
HELP1 ;EP
+1 ;----> Explanation of this report.
+2 NEW BITEXT
DO TEXT1(.BITEXT)
+3 DO START^BIHELP("EDIT NDC CODES - HELP",.BITEXT)
+4 ;
+5 ;---> Redisplay Message area (with number of NDCs) in List Template.
+6 DO RESET^BINDC1
+7 QUIT
+8 ;
+9 ; vvv83
+10 ;----------
TEXT1(BITEXT) ;EP
+1 ;;
+2 ;;This screen allows you to view and edit the fields of NDC CODES.
+3 ;;
+4 ;;NOTE: To show INACTIVE NDC CODES, select "D Display Inactives."
+5 ;;
+6 ;;To Add a new NDC Number, type "A". If the NDC Number already exists in
+7 ;;the Table, a message will display, directng you select that NDC Number
+8 ;;for editing.
+9 ;;
+10 ;;To edit an existing NDC Number type "E" and then select the left column
+11 ;;number that corresponds to the NDC Number you wish to edit.
+12 ;;
+13 ;;You may also SEARCH the entire list for any number, name, or combination
+14 ;;of characters by usinng the "S Search List" action.
+15 ;;
+16 ;;You may list the NDCs by either NDC Code or Vaccine (alphabetically) using
+17 ;;the Change List Order action.
+18 ;;
+19 ;;
+20 DO LOADTX("TEXT1",,.BITEXT)
+21 QUIT
+22 ;
+23 ;
+24 ;----------
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 ;----------
TEXT3 ;EP
+1 ;;
+2 ;;This option will automatically INACTIVATE ALL NDC CODES that
+3 ;;have EXPIRED (an Expiration Date prior to today).
+4 ;;
+5 ;;It will also automatically INACTIVATE ALL NDC CODES that have
+6 ;;NO Expiration Date (as viewed in the NDC Number Table).
+7 ;;
+8 ;; Note: You can REACTIVATE any NDC Number individually at any time
+9 ;; by editing the NDC Number individually from the Edit NDC CODES
+10 ;; Screen (and resetting the Active Field for that NDC Number).
+11 ;;
+12 ;;Do you wish to INACTIVATE ALL NDC CODES that either have EXPIRED
+13 ;;or have NO Expiration Date?
+14 ;;
+15 DO PRINTX("TEXT3")
+16 QUIT
+17 ;
+18 ;
+19 ;----------
TEXT33 ;EP
+1 ;;
+2 ;;Okay.
+3 ;;Please confirm that you wish Inactivate all NDC CODES that
+4 ;;either have EXPIRED or have NO Expiration Eate, by typing "YES"
+5 ;;a second time. (Enter NO to discontinue this process.)
+6 ;;
+7 DO PRINTX("TEXT33")
+8 QUIT
+9 ;
+10 ;
+11 ;----------
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 ;---> End of job cleanup.
+2 DO KILLALL^BIUTL8()
+3 KILL ^TMP("BINDC",$JOB)
+4 DO CLEAR^VALM1
+5 DO FULL^VALM1
+6 QUIT
+7 ;
+8 ;
+9 ;----------
NDC(IEN,FORM) ;EP
+1 ;---> Return NDC Code values from BI TABLE NDC CODES File.
+2 ;---> Parameters:
+3 ; 1 - IEN (req) IEN of NDC Code.
+4 ; 2 - FORM (opt) FORM of Code to return:
+5 ; 1=Actual NDC Code (also default)
+6 ; 2=Vaccine Pointer (use for Vaccine Name or CVX)
+7 ; 3=Manufacturer Pointer
+8 ; 4=Product Name
+9 ; 5=Status
+10 ;
+11 IF '$GET(IEN)
QUIT ""
+12 IF '$DATA(^BINDC(IEN,0))
QUIT "NO GLOBAL"
+13 NEW Y
SET Y=^BINDC(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 QUIT $PIECE(Y,U)
