Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BINDC

BINDC.m

Go to the documentation of this file. 
  1. BINDC ;IHS/CMI/MWR - EDIT NDC CODES.; MAY 10, 2010
  1.  ;;8.5;IMMUNIZATION;**9**;OCT 01,2014
  1.  ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1.  ;;  EDIT NDC NUMBER FIELDS.
  1.  ;   PATCH 2: Redisplay Message area (with # of NDCs) in List Template. HELP+5
  1.  ;
  1.  ;
  1.  ;
  1.  ;----------
  1. START ;EP
  1.  ;---> Lookup NDC CODES and edit their fields.  vvv83
  1.  D SETVARS^BIUTL5 K ^TMP("BINDC",$J) N BICOLL,BISUBT,BITMP,BIINACT
  1.  S BISUBT="1:NDC Code;2:Vaccine Name, then by NDC Code"
  1.  ;S BISUBT=BISUBT_";5:Vaccine Name, then by Exp Date"
  1.  ;
  1.  ;---> If Vaccine Table is not standard, display Error Text and quit.
  1.  I $D(^BISITE(-1)) D ERRCD^BIUTL2(503,,1) Q
  1.  ;
  1.  D EN
  1.  D EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EN ;EP
  1.  D EN^VALM("BI NDC TABLE EDIT")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINT ;EP
  1.  ;---> Print NDC Number Table.
  1.  ;---> Called by Protocol BI NDC NUMBER TABLE PRINT, which is the
  1.  ;---> Print List Protocol for the List: BI NDC NUMBER TABLE EDIT.
  1.  ;
  1.  D DEVICE(.BIPOP)
  1.  I $G(BIPOP) D RESET Q
  1.  ;
  1.  D HDR(1),INIT^BINDC1
  1.  D PRTLST^BIUTL8("BINDC")
  1.  D RESET
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HDR(BIPRT) ;EP
  1.  ;---> Header code for both Listman Screen and Print List.
  1.  ;---> Parameters:
  1.  ;     1 - BIPRT  (opt) If BIPRT=1 array is for print: Change column
  1.  ;                      header line and add Site Header line.
  1.  ;
  1.  N BILINE,X,Y S BILINE=0 K VALMHDR
  1.  N BICRT S BICRT=$S(($E($G(IOST))="C")!(IOST["BROWSER"):1,1:0)
  1.  ;
  1.  D WH^BIW(.BILINE)
  1.  S X=$$REPHDR^BIUTL6(DUZ(2)),BIDASH=$L(X)+2 D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  S X=$$SP^BIUTL5(BIDASH,"-") D CENTERT^BIUTL5(.X)
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  S X="NDC NUMBER TABLE" S:'$G(BIPRT) X="EDIT "_X
  1.  D CENTERT^BIUTL5(.X)
  1.  S:BICRT X=IOINHI_X_IOINORM
  1.  D WH^BIW(.BILINE,X)
  1.  ;
  1.  ;---> Subtitle: indicate order of listing.
  1.  D:($G(BICOLL)&$D(BISUBT))
  1.  .N Y S Y=$P($P(BISUBT,BICOLL_":",2),";") S X=" (Listed by "_Y_")"
  1.  .D CENTERT^BIUTL5(.X) S:BICRT X=IOINHI_X_IOINORM D WH^BIW(.BILINE,X)
  1.  ;
  1.  D:$G(BIPRT)
  1.  .S X=$$SP^BIUTL5(51)_"Printed: "_$$NOW^BIUTL5()
  1.  .D WH^BIW(.BILINE,X,1)
  1.  .S X="  #  NDC Code         Vaccine     CVX  Manufacturer  Product         Status"
  1.  .D WH^BIW(.BILINE,X)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. INIT ;EP
  1.  ;---> Initialize variables and list array.
  1.  D INIT^BINDC1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. RESET ;EP
  1.  ;---> Update partition for return to Listmanager.
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D INIT,HDR() Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DEVICE(BIPOP) ;EP
  1.  ;---> Get Device and possibly queue to Taskman.
  1.  ;---> Parameters:
  1.  ;     1 - BIPOP (ret) If error or Queue, BIPOP=1
  1.  ;
  1.  K %ZIS,IOP S BIPOP=0
  1.  S ZTRTN="DEQUEUE^BINDC"
  1.  D ZSAVES^BIUTL3
  1.  D ZIS^BIUTL2(.BIPOP,1)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. DEQUEUE ;EP
  1.  ;---> Print Patient Data screen.
  1.  D HDR(1),INIT^BINDC1
  1.  D PRTLST^BIUTL8("BINDC"),EXIT
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP ;EP
  1.  ;---> Help code.
  1.  N BIX S BIX=X
  1.  D FULL^VALM1
  1.  W !!?5,"Enter ""A"" to add or edit an NDC Code, enter ""E"" to select and Edit an"
  1.  W !?5,"NDC Code from the left column, enter ""C"" to change the order of the list,"
  1.  W !?5,"""S"" to Search for a particular NDC Code, ""D"" to include NDC Codes"
  1.  W !?5,"in the display (will appear after all Active Lot Numbers),and enter ""H"""
  1.  W !?5,"to view the full help text for the NDC list and its parameters."
  1.  D DIRZ^BIUTL3("","     Press ENTER/RETURN to continue")
  1.  D:BIX'="??" RE^VALM4
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. HELP1 ;EP
  1.  ;----> Explanation of this report.
  1.  N BITEXT D TEXT1(.BITEXT)
  1.  D START^BIHELP("EDIT NDC CODES - HELP",.BITEXT)
  1.  ;
  1.  ;---> Redisplay Message area (with number of NDCs) in List Template.
  1.  D RESET^BINDC1
  1.  Q
  1.  ;
  1.  ;   vvv83
  1.  ;----------
  1. TEXT1(BITEXT) ;EP
  1.  ;;
  1.  ;;This screen allows you to view and edit the fields of NDC CODES.
  1.  ;;
  1.  ;;NOTE: To show INACTIVE NDC CODES, select "D Display Inactives."
  1.  ;;
  1.  ;;To Add a new NDC Number, type "A".  If the NDC Number already exists in
  1.  ;;the Table, a message will display, directng you select that NDC Number
  1.  ;;for editing.
  1.  ;;
  1.  ;;To edit an existing NDC Number type "E" and then select the left column
  1.  ;;number that corresponds to the NDC Number you wish to edit.
  1.  ;;
  1.  ;;You may also SEARCH the entire list for any number, name, or combination
  1.  ;;of characters by usinng the "S Search List" action.
  1.  ;;
  1.  ;;You may list the NDCs by either NDC Code or Vaccine (alphabetically) using
  1.  ;;the Change List Order action.
  1.  ;;
  1.  ;;
  1.  D LOADTX("TEXT1",,.BITEXT)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. LOADTX(BILINL,BITAB,BITEXT) ;EP
  1.  Q:$G(BILINL)=""
  1.  N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  S BITEXT(I)=T_$P(X,";;",2)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT3 ;EP
  1.  ;;
  1.  ;;This option will automatically INACTIVATE ALL NDC CODES that
  1.  ;;have EXPIRED (an Expiration Date prior to today).
  1.  ;;
  1.  ;;It will also automatically INACTIVATE ALL NDC CODES that have
  1.  ;;NO Expiration Date (as viewed in the NDC Number Table).
  1.  ;;
  1.  ;;   Note: You can REACTIVATE any NDC Number individually at any time
  1.  ;;   by editing the NDC Number individually from the Edit NDC CODES
  1.  ;;   Screen (and resetting the Active Field for that NDC Number).
  1.  ;;
  1.  ;;Do you wish to INACTIVATE ALL NDC CODES that either have EXPIRED
  1.  ;;or have NO Expiration Date?
  1.  ;;
  1.  D PRINTX("TEXT3")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. TEXT33 ;EP
  1.  ;;
  1.  ;;Okay.
  1.  ;;Please confirm that you wish Inactivate all NDC CODES that
  1.  ;;either have EXPIRED or have NO Expiration Eate, by typing "YES"
  1.  ;;a second time.  (Enter NO to discontinue this process.)
  1.  ;;
  1.  D PRINTX("TEXT33")
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. PRINTX(BILINL,BITAB) ;EP
  1.  Q:$G(BILINL)=""
  1.  N I,T,X S T="" S:'$D(BITAB) BITAB=5 F I=1:1:BITAB S T=T_" "
  1.  F I=1:1 S X=$T(@BILINL+I) Q:X'[";;"  W !,T,$P(X,";;",2)
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. EXIT ;EP
  1.  ;---> End of job cleanup.
  1.  D KILLALL^BIUTL8()
  1.  K ^TMP("BINDC",$J)
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1.  ;
  1.  ;----------
  1. NDC(IEN,FORM) ;EP
  1.  ;---> Return NDC Code values from BI TABLE NDC CODES File.
  1.  ;---> Parameters:
  1.  ;     1 - IEN  (req) IEN of NDC Code.
  1.  ;     2 - FORM (opt) FORM of Code to return:
  1.  ;                        1=Actual NDC Code (also default)
  1.  ;                        2=Vaccine Pointer (use for Vaccine Name or CVX)
  1.  ;                        3=Manufacturer Pointer
  1.  ;                        4=Product Name
  1.  ;                        5=Status
  1.  ;
  1.  Q:'$G(IEN) ""
  1.  Q:'$D(^BINDC(IEN,0)) "NO GLOBAL"
  1.  N Y S Y=^BINDC(IEN,0)
  1.  ;
  1.  Q:$G(FORM)=2 $P(Y,U,2)
  1.  Q:$G(FORM)=3 $P(Y,U,3)
  1.  Q:$G(FORM)=4 $P(Y,U,4)
  1.  Q:$G(FORM)=5 $P(Y,U,5)
  1.  Q $P(Y,U)