BILOT1 ;IHS/CMI/MWR - EDIT LOT NUMBERS.; MAY 10, 2010
;;8.5;IMMUNIZATION;**2**;MAY 15,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; EDIT LOT NUMBER FIELDS.
; PATCH 2: Display number of Lots in list. INIT+50
;
;
;----------
INIT ;EP
;---> Initialize variables and list array.
;
S VALMSG="Enter ?? for more actions."
S VALM("TITLE")=$$LMVER^BILOGO
;
;---> Build Listmanager array.
K ^TMP("BILOT",$J),BILOT,BITMP
N BIENT,BILINE,BITMP S BIENT=0,BILINE=0
;---> BICOLL=Order of Listing (see linelabel CHGORDR below.
S:'$G(BICOLL) BICOLL=1
;---> Exclude inactive lots unless BIINACT=1. vvv83
S:'$G(BIINACT) BIINACT=0
;
N BIIEN S BIIEN=0
F S BIIEN=$O(^AUTTIML(BIIEN)) Q:'BIIEN D
.I '$D(^AUTTIML(BIIEN,0)) K ^AUTTIML(BIIEN) Q
.N BIACT,BIEXP,BILOT,BIVNAM,BIUNSD,Y,X,Z
.S Y=^AUTTIML(BIIEN,0),BILOT=$P(Y,U),BIACT=+$P(Y,U,3)
.S BIUNSD=$P(Y,U,12) S:BIUNSD="" BIUNSD="NA"
.;---> Quit if excluding Inactive Lots.
.Q:('BIINACT&BIACT=1)
.S:BILOT="" BILOT="UNKNOWN"
.;---> If no Exp Date, set Exp Date=last in list.
.S BIEXP=+$P(Y,U,9) S:'BIEXP BIEXP=9999999
.S BIVNAM=+$P(Y,U,4),BIVNAM=$$VNAME^BIUTL2(BIVNAM)
.D
..I BICOLL=2 S W=BIEXP,X=BIVNAM,Y=BIUNSD,Z=BILOT Q ;vvv83
..I BICOLL=3 S W=BILOT,X=BIVNAM,Y=BIEXP,Z=BIUNSD Q
..I BICOLL=4 S W=BIVNAM,X=BIUNSD,Y=BIEXP,Z=BILOT Q
..I BICOLL=5 S W=BIVNAM,X=BIEXP,Y=BIUNSD,Z=BILOT Q
..I BICOLL=6 S W=BIVNAM,X=BILOT,Y=BIEXP,Z=BILOT Q
.. S W=BIUNSD,X=BIVNAM,Y=BIEXP,Z=BILOT Q
.S BITMP(BIACT,W,X,Y,Z,BIIEN)=BIIEN
;
N N S N="" F S N=$O(BITMP(N)) Q:(N="") D
.;---> Place a linefeed between Active and Inactive.
.I N D WRITE(.BILINE,,,BIENT)
.;
.N M S M="" F S M=$O(BITMP(N,M)) Q:(M="") D
..N L S L="" F S L=$O(BITMP(N,M,L)) Q:(L="") D
...N K S K="" F S K=$O(BITMP(N,M,L,K)) Q:(K="") D
....N J S J="" F S J=$O(BITMP(N,M,L,K,J)) Q:(J="") D
.....N P S P="" F S P=$O(BITMP(N,M,L,K,J,P)) Q:(P="") D
......D LINE(BITMP(N,M,L,K,J,P),.BILINE,.BIENT)
;
;---> Finish up Listmanager List Count.
S VALMCNT=BILINE
I VALMCNT>12 D
.;
.;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
.;---> Display number of Lots in list.
.;S VALMSG="Scroll down to view more. Type ?? for more actions"
.N Y S Y=VALMCNT S:$G(BIINACT) Y=Y-1
.S VALMSG=Y_" Lots: Scroll down to view more, or type ??."
.;**********
Q
;
;
;----------
LINE(BIIEN,BILINE,BIENT) ;EP
;---> Gather data for each Lot and write to ^TMP.
;---> Parameters:
; 1 - BIIEN (req) IEN of Lot.
; 2 - BILINE (ret) Last line# written.
; 3 - BIENT (opt) Entry Number for LM selection in VALMY
;
N BI0,X,Y
S BI0=^AUTTIML(BIIEN,0)
;
;---> Set Item# and build Item# array=IEN of Vaccine.
S BIENT=BIENT+1,BILOT(BIENT)=BIIEN
;
;---> Item#.
S X=" "_$S(BIENT<10:" "_BIENT,1:BIENT)
;
;---> Lot Number.
S X=X_" "_$P(BI0,U)
S X=$$PAD^BIUTL5(X,27,".")
;
;---> Vaccine.
S X=X_$$VNAME^BIUTL2($P(BI0,U,4))
S X=$$PAD^BIUTL5(X,39,".")
;
;---> Active/Inactive.
S X=X_$S($P(BI0,U,3)=1:"Inactive",1:"Active")
S X=$$PAD^BIUTL5(X,47,".")
;
;---> Expiration Date.
I $P(BI0,U,9) S X=X_$$LOTEXP^BIRPC3(BIIEN,1)
S X=$$PAD^BIUTL5(X,57,".")
;
;---> Starting Count.
I $P(BI0,U,11) S X=X_$J($P(BI0,U,11),5)
S X=$$PAD^BIUTL5(X,64,".")
;
;---> Doses Unused (amount left).
I $P(BI0,U,11) S X=X_$J($$LOTRBAL^BIRPC3(BIIEN),5)
S X=$$PAD^BIUTL5(X,71,".")
;
;---> Facility (if entered).
I $P(BI0,U,14) S X=X_$E($$INSTTX^BIUTL6($P(BI0,U,14)),1,8)
S X=$$PAD^BIUTL5(X,80,".")
;
;---> Set this Vaccine display row and index in ^TMP.
D WRITE(.BILINE,X,,BIENT)
Q
;
;
;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
;---> Write lines to ^TMP (see documentation in ^BIW).
;---> Parameters:
; 1 - BILINE (ret) Last line# written.
; 2 - BIVAL (opt) Value/text of line (Null=blank line).
; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
; 4 - BIENT (opt) Entry Number for LM selection in VALMY
;
Q:'$D(BILINE)
D WL^BIW(.BILINE,"BILOT",$G(BIVAL),$G(BIBLNK),$G(BIENT))
Q
;
;
;----------
EDITLOT(BINEW) ;EP
;---> Edit a Lot Number.
;---> Parameters:
; 2 - BINEW (opt) 1=new lot number being added; 0/""=edit.
;
;---> Steps:
; 1) This entry point is called by the Protocol:
; BI LOT NUMBER SELECT, an action on the
; List Manager menu protocol: BI MENU LOT NUMBER EDIT.
;
; 2) This code calls ScreenMan form:
; BI FORM-LOT NUMBER EDIT to build BI local array
; of data for add/edit of a Lot Number.
; Data already stored in the BI local array is loaded
; into the form by LOADLOT^BILOT1, which is called
; by the Pre-Action of Block for Vaccine Edit.
;
; 3) Use BI local array to send data to FDIE^BIFMAN.
;
;---> If BINEW, add a new Lot Number and quit.
I $G(BINEW) D EDITSCR(,1) D RESET Q
;
;---> Call the Listmanager Generic Selector of items displayed.
N VALMY
D EN^VALM2(XQORNOD(0),"OS")
;
;---> Check that a Listman Item was passed.
I '$D(VALMY) D ERRCD^BIUTL2(406,,1) D RESET Q
;---> Now set Y=Item# selected from the list.
N Y S Y=$O(VALMY(0))
I '$G(Y) D ERRCD^BIUTL2(406,,1) D RESET Q
I $G(BILOT(Y))="" D ERRCD^BIUTL2(511,,1) D RESET Q
D EDITSCR(+BILOT(Y))
D FULL^VALM1
D RESET
Q
;
;
;----------
EDITSCR(BILOT,BINEW) ;EP
;---> Add or edit the fields of a Lot Number.
;---> (Make this an RPC in the future?)
;---> Parameters:
; 1 - BILOT (opt) Lot Number IEN.
; 2 - BINEW (opt) 1=new lot number being added; 0=edit.
;
;---> If this is an edit, check that IEN of Lot Number.
I '$G(BINEW),$G(^AUTTIML(+$G(BILOT),0))="" D ERRCD^BIUTL2(511,,1) Q
;
;---> If this is an edit, preload existing values for Screenman form.
N BI D:$G(BILOT)
.N Y S Y=^AUTTIML(BILOT,0)
.S BI("AS")=$P(Y,U,1) ;Full Lot Number Text.
.S BI("A")=$P(BI("AS"),"*") ;Lot Number Text.
.S BI("S")=$P(BI("AS"),"*",2) ;Lot Number Text.
.S BI("B")=$P(Y,U,4) ;Vaccine.
.S BI("C")=+$P(Y,U,3) ;Status Active/Inactive.
.S BI("D")=$P(Y,U,9) ;Expiration Date.
.S BI("E")=$P(Y,U,11) ;Starting Count.
.S BI("F")=$P(Y,U,12) ;Doses Unused.
.S BI("G")=$P(Y,U,15) ;Low Supply Alert.
.S BI("H")=$P(Y,U,13) ;Source VFC or NON-VFC.
.S BI("M")=$P(Y,U,2) ;Manufacturer.
.S BI("N")=$P(Y,U,14) ;Facility.
.S BI("O")=$P(Y,U,17) ;NDC Code.
;
;---> Call Screenman to build BI local array of data by user.
N BISAVE
N DR S DR="[BI FORM-LOT NUMBER EDIT]"
D DDS^BIFMAN(9999999.41,DR,$G(BILOT),"S",.BISAVE,.BIPOP)
;
;---> Quit if user did not save this data.
Q:('$G(BISAVE))
;
;---> Build local array for this Lot Number.
N BIERR,BIFLD
S BI("AS")=BI("A")
I $G(BI("S"))]"" S BI("AS")=BI("AS")_"*"_BI("S")
;
;---> v8.5: If Active Status="", set it to 0, so PCC will be happy.
I $G(BI("C"))="" S BI("C")=0
;
S BIFLD(.01)=$G(BI("AS")),BIFLD(.03)=$G(BI("C")),BIFLD(.09)=$G(BI("D"))
S BIFLD(.11)=$G(BI("E")),BIFLD(.12)=$G(BI("F")),BIFLD(.15)=$G(BI("G"))
S BIFLD(.13)=$G(BI("H")),BIFLD(.02)=$G(BI("M")),BIFLD(.14)=$G(BI("N"))
S BIFLD(.16)=$G(BI("A")),BIFLD(.17)=$G(BI("O"))
;---> If this is a new Lot Number, include the Vaccine.
S:$G(BINEW) BIFLD(.04)=$G(BI("B"))
;
;
;---> If this is a new Lot Number and it already exists (not a sub-lot),
;---> then display error and quit.
I $G(BINEW),$D(^AUTTIML("B",BI("AS"))) D Q
.D CLEAR^VALM1,FULL^VALM1,TITLE^BIUTL5("EDIT LOT NUMBER FIELDS")
.W !!?23,"This Lot Number already exists!"
.W !!?18,"Please exit and select it from the list."
.W !!!!?5,"NOTE: It It may be Inactive. Try displaying Inactive Lot Numbers"
.W !?11,"as well as Active ones.",!
.D DIRZ^BIUTL3()
;
;
;---> Add/update the Lot Number.
D
.I $G(BINEW) D UPDATE^BIFMAN(9999999.41,.BILOT,.BIFLD,.BIERR) Q
.D FDIE^BIFMAN(9999999.41,BILOT,.BIFLD,.BIERR)
;
;---> If there was an error, display it.
I $G(BIERR)]"" D Q
.D CLEAR^VALM1,FULL^VALM1,TITLE^BIUTL5("EDIT LOT NUMBER FIELDS")
.W !!?3,BIERR D DIRZ^BIUTL3()
;
Q
;
;
;----------
LOADLOT ;EP
;---> Code to load Lot Number data for ScreenMan Edit form.
;---> Called by Pre Action of Block BI BLK-LOT NUMBER EDIT on
;---> Form BI FORM-LOT NUMBER EDIT.
;
;---> If this is a NEW Lot Number, enable editing of Vaccine, Field 2.
I $G(BINEW) D UNED^DDSUTL(2,,,0)
;
;---> Load Lot Number.
I $G(BI("A"))]"" D PUT^DDSVALF(1,,,BI("A"),"I")
;
;---> Load Sub-lot, if it exists.
I $G(BI("S"))]"" D PUT^DDSVALF(1.5,,,BI("S"),"I")
;
;---> Load Vaccine Name (.01).
I $G(BI("B"))]"" D PUT^DDSVALF(2,,,BI("B"),"I")
;
;---> Load Vaccine Short Name (.02).
I $G(BI("B"))]"" D PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BI("B"))_")")
;
;---> Load Lot Number Status Active/Inactive.
I $G(BI("C"))]"" D PUT^DDSVALF(3,,,BI("C"),"I")
;
;---> Load Lot Number Expiration Date.
I $G(BI("D"))]"" D PUT^DDSVALF(4,,,BI("D"),"I")
;
;---> Load the Starting Count.
I $G(BI("E"))]"" D PUT^DDSVALF(5,,,BI("E"),"I")
;
;---> Load the Doses Unused.
I $G(BI("F"))]"" D PUT^DDSVALF(6,,,BI("F"),"I")
;
;---> Load the Low Supply Alert.
I $G(BI("G"))]"" D PUT^DDSVALF(7,,,BI("G"),"I")
;
;---> Load the Source (VFC or NON-VFC).
I $G(BI("H"))]"" D PUT^DDSVALF(11,,,BI("H"),"I")
;
;---> Load Manufacturer.
I $G(BI("M"))]"" D PUT^DDSVALF(10,,,BI("M"),"I")
;
;---> Load Facility.
I $G(BI("N"))]"" D PUT^DDSVALF(9,,,BI("N"),"I")
;
;---> Load NDC Code.
I $G(BI("O"))]"" D PUT^DDSVALF(4.5,,,BI("O"),"I")
;
;---> Calculate the number of doses that have been used.
D CALCDOS($G(BI("E")),$G(BI("F")))
Q
;
;
;----------
INVOFF(BIZ) ;EP
;---> Trigger Popup that Doses Unused cannot be greater than
;---> the Starting Count.
;---> Called from Fields 5 & 6 on Form BI FORM-LOT NUMBER EDIT.
;---> Parameters:
; 1 - BIZ (req) Field triggered from: 1=Starting Count
; 2=Doses Unused
;
Q:'$G(BIZ)
S DDSSTACK="BI PAGE-INVENTORY OFF"
I BIZ=1 D PUT^DDSVALF(5,,,$G(DDSOLD),"I") Q
I BIZ=2 D PUT^DDSVALF(6,,,$G(DDSOLD),"I") Q
Q
;
;
;----------
CALCDOS(E,F) ;EP
;---> Calculate the number of doses of a Lot Number that have been used.
;---> Called from Fields 5 & 6 on Form BI FORM-LOT NUMBER EDIT.
;---> Parameters:
; 1 - E (req) Starting Count
; 2 - F (req) Doses Unused
;
Q:($G(E)="") Q:($G(F)="")
D PUT^DDSVALF(8,,,(E-F),"I")
Q
;
;
;----------
VACINA1 ;EP
;---> Trigger Popup that says vaccine must be Active.
;---> Called from Fields 2 on Form BI FORM-LOT NUMBER EDIT.
;
;---> If this vaccine is Inactive, display popup.
;---> Ex
I $P($G(^AUTTIMM(+X,0)),U,7) D Q
.S DDSSTACK="BI PAGE-INACTIVE VACCINE"
;
S BINEW(1)=1 S DDSBR=10
I $G(X) S BI("B")=X D PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(X)_")")
Q
;
;
;----------
VACINA2 ;EP
;---> Called from Fields 3 on Form BI FORM-LOT NUMBER EDIT.
;---> If no vaccine was selected, send user back to Field 2 (vaccine).
I '$G(BI("B")) S DDSBR=2 D Q
.;D HLP^DDSUTL("Select the Vaccine that corresponds to this Lot Number.")
;
N BIT S BIT="Select whether this Lot Number should be Active or Inactive."
S BIT=BIT_" Note that users will not be able to select an Inactive Lot "
S BIT=BIT_"Number if the Category is Ambulatory."
D HLP^DDSUTL(BIT)
Q
;
;
;----------
VACINA3 ;EP
;---> After code from popup, going back to Form BI FORM-LOT NUMBER EDIT.
;---> To get there: Get to the form (above), press F1-P, then page 5,
;---> then F1-V, tab to BI BLK-..., spacebar, F4, Post Action at the bottom.
;
;---> Kill the vaccine node, null out the display of vaccine names.
K BI("B") D PUT^DDSVALF(2,2,1,,"E"),PUT^DDSVALF(2.5,2,1,,"E")
Q
;
;
;----------
RESET ;EP
;---> Update partition for return to Listmanager.
I $D(VALMQUIT) S VALMBCK="Q" Q
D TERM^VALM0 S VALMBCK="R"
D INIT^BILOT,HDR^BILOT()
Q
;
;
;----------
CHGORDR ;EP
;
D CHGORDR^BILOT2
Q
;
;
;----------
TEXT2 ;EP
;;
;;The Lot Number Table will always be listed with the group of
;;all ACTIVE Lot Numbers first, followed by all INACTIVE Lot Numbers.
;;However, within those two groups you may select the order in which
;;the Lot Numbers are displayed, as follows:
;;
;; 1) By Unused Doses (least first)
;; 2) By Expiration Date
;; 3) By Lot Number
;; 4) By Vaccine Name, then by Unused Doses
;; 5) By Vaccine Name, then by Exp Date
;; 6) By Vaccine Name, then by Lot Number
;;
D PRINTX("TEXT2")
Q
;
;
;----------
INACTA ;EP
;---> Automatically Inactivate old Lot Numbers that either have expired
;---> or have no Expiration Date.
;
D FULL^VALM1,TITLE^BIUTL5("INACTIVATE OLD LOT NUMBERS"),TEXT3^BILOT
N DIR,Y D INACTA1
D ^DIR
S:$D(DIRUT) BIPOP=1
I Y'=1 D Q
.W !!?5,"Okay. NO changes made!" D DIRZ^BIUTL3()
.D RESET
;
D TITLE^BIUTL5("INACTIVATE OLD LOT NUMBERS"),TEXT33^BILOT,INACTA1
D ^DIR
S:$D(DIRUT) BIPOP=1
I Y'=1 D Q
.W !!?5,"Okay. NO changes made!" D DIRZ^BIUTL3()
.D RESET
;
D INACTLN
D RESET
Q
;
;
;----------
INACTA1 ;EP
;---> Set DIR values for linelabel INACTA.
S DIR(0)="YA"
S DIR("A")=" Please answer either YES or NO: ",DIR("B")="NO"
S DIR("?",1)=" Enter YES to automatically Inactivate Lot Numbers, "
S DIR("?")=" enter NO to make no changes."
Q
;
;
;----------
INACTLN ;EP
;---> Inactivate all Lot Numbers that either have expired or have
;---> no Expiration Date.
;
D ^XBKVAR
N M,N S M=0,N=0
F S N=$O(^AUTTIML(N)) Q:'N D
.Q:'$D(^AUTTIML(N,0))
.;---> Do not Inactivate if Exp Date is later than Today.
.Q:($P(^AUTTIML(N,0),"^",9)>$G(DT))
.;---> Quit if this Lot Number is already Inactive.
.Q:($P(^AUTTIML(N,0),"^",3)=1)
.;---> Inactivate this Lot Number.
.S $P(^AUTTIML(N,0),"^",3)=1,M=M+1
W !!?5,"Done. ",M," Lot Numbers have been Inactivated." D DIRZ^BIUTL3()
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
;
;
;----------
NULLACT ;EP
;---> Activate all Lot Numbers that have a Status=null.
;---> Call by postinit for Imm v8.5.
;
D ^XBKVAR
W !!?5,"Checking Lot Numbers for null Status..."
N M,N S M=0,N=0
F S N=$O(^AUTTIML(N)) Q:'N D
.Q:'$D(^AUTTIML(N,0))
.;---> Quit if this lot number has a Status .
.Q:($P(^AUTTIML(N,0),"^",3)'="")
.;---> Okay, Status must be null, so set it to Active.
.S $P(^AUTTIML(N,0),"^",3)=0,M=M+1
W !!?5,"Done. ",M," Lot Numbers have been fixed." D DIRZ^BIUTL3()
Q
BILOT1 ;IHS/CMI/MWR - EDIT LOT NUMBERS.; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**2**;MAY 15,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; EDIT LOT NUMBER FIELDS.
+4 ; PATCH 2: Display number of Lots in list. INIT+50
+5 ;
+6 ;
+7 ;----------
INIT ;EP
+1 ;---> Initialize variables and list array.
+2 ;
+3 SET VALMSG="Enter ?? for more actions."
+4 SET VALM("TITLE")=$$LMVER^BILOGO
+5 ;
+6 ;---> Build Listmanager array.
+7 KILL ^TMP("BILOT",$JOB),BILOT,BITMP
+8 NEW BIENT,BILINE,BITMP
SET BIENT=0
SET BILINE=0
+9 ;---> BICOLL=Order of Listing (see linelabel CHGORDR below.
+10 IF '$GET(BICOLL)
SET BICOLL=1
+11 ;---> Exclude inactive lots unless BIINACT=1. vvv83
+12 IF '$GET(BIINACT)
SET BIINACT=0
+13 ;
+14 NEW BIIEN
SET BIIEN=0
+15 FOR
SET BIIEN=$ORDER(^AUTTIML(BIIEN))
IF 'BIIEN
QUIT
Begin DoDot:1
+16 IF '$DATA(^AUTTIML(BIIEN,0))
KILL ^AUTTIML(BIIEN)
QUIT
+17 NEW BIACT,BIEXP,BILOT,BIVNAM,BIUNSD,Y,X,Z
+18 SET Y=^AUTTIML(BIIEN,0)
SET BILOT=$PIECE(Y,U)
SET BIACT=+$PIECE(Y,U,3)
+19 SET BIUNSD=$PIECE(Y,U,12)
IF BIUNSD=""
SET BIUNSD="NA"
+20 ;---> Quit if excluding Inactive Lots.
+21 IF ('BIINACT&BIACT=1)
QUIT
+22 IF BILOT=""
SET BILOT="UNKNOWN"
+23 ;---> If no Exp Date, set Exp Date=last in list.
+24 SET BIEXP=+$PIECE(Y,U,9)
IF 'BIEXP
SET BIEXP=9999999
+25 SET BIVNAM=+$PIECE(Y,U,4)
SET BIVNAM=$$VNAME^BIUTL2(BIVNAM)
+26 Begin DoDot:2
+27 ;vvv83
IF BICOLL=2
SET W=BIEXP
SET X=BIVNAM
SET Y=BIUNSD
SET Z=BILOT
QUIT
+28 IF BICOLL=3
SET W=BILOT
SET X=BIVNAM
SET Y=BIEXP
SET Z=BIUNSD
QUIT
+29 IF BICOLL=4
SET W=BIVNAM
SET X=BIUNSD
SET Y=BIEXP
SET Z=BILOT
QUIT
+30 IF BICOLL=5
SET W=BIVNAM
SET X=BIEXP
SET Y=BIUNSD
SET Z=BILOT
QUIT
+31 IF BICOLL=6
SET W=BIVNAM
SET X=BILOT
SET Y=BIEXP
SET Z=BILOT
QUIT
+32 SET W=BIUNSD
SET X=BIVNAM
SET Y=BIEXP
SET Z=BILOT
QUIT
End DoDot:2
+33 SET BITMP(BIACT,W,X,Y,Z,BIIEN)=BIIEN
End DoDot:1
+34 ;
+35 NEW N
SET N=""
FOR
SET N=$ORDER(BITMP(N))
IF (N="")
QUIT
Begin DoDot:1
+36 ;---> Place a linefeed between Active and Inactive.
+37 IF N
DO WRITE(.BILINE,,,BIENT)
+38 ;
+39 NEW M
SET M=""
FOR
SET M=$ORDER(BITMP(N,M))
IF (M="")
QUIT
Begin DoDot:2
+40 NEW L
SET L=""
FOR
SET L=$ORDER(BITMP(N,M,L))
IF (L="")
QUIT
Begin DoDot:3
+41 NEW K
SET K=""
FOR
SET K=$ORDER(BITMP(N,M,L,K))
IF (K="")
QUIT
Begin DoDot:4
+42 NEW J
SET J=""
FOR
SET J=$ORDER(BITMP(N,M,L,K,J))
IF (J="")
QUIT
Begin DoDot:5
+43 NEW P
SET P=""
FOR
SET P=$ORDER(BITMP(N,M,L,K,J,P))
IF (P="")
QUIT
Begin DoDot:6
+44 DO LINE(BITMP(N,M,L,K,J,P),.BILINE,.BIENT)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+45 ;
+46 ;---> Finish up Listmanager List Count.
+47 SET VALMCNT=BILINE
+48 IF VALMCNT>12
Begin DoDot:1
+49 ;
+50 ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
+51 ;---> Display number of Lots in list.
+52 ;S VALMSG="Scroll down to view more. Type ?? for more actions"
+53 NEW Y
SET Y=VALMCNT
IF $GET(BIINACT)
SET Y=Y-1
+54 SET VALMSG=Y_" Lots: Scroll down to view more, or type ??."
+55 ;**********
End DoDot:1
+56 QUIT
+57 ;
+58 ;
+59 ;----------
LINE(BIIEN,BILINE,BIENT) ;EP
+1 ;---> Gather data for each Lot and write to ^TMP.
+2 ;---> Parameters:
+3 ; 1 - BIIEN (req) IEN of Lot.
+4 ; 2 - BILINE (ret) Last line# written.
+5 ; 3 - BIENT (opt) Entry Number for LM selection in VALMY
+6 ;
+7 NEW BI0,X,Y
+8 SET BI0=^AUTTIML(BIIEN,0)
+9 ;
+10 ;---> Set Item# and build Item# array=IEN of Vaccine.
+11 SET BIENT=BIENT+1
SET BILOT(BIENT)=BIIEN
+12 ;
+13 ;---> Item#.
+14 SET X=" "_$SELECT(BIENT<10:" "_BIENT,1:BIENT)
+15 ;
+16 ;---> Lot Number.
+17 SET X=X_" "_$PIECE(BI0,U)
+18 SET X=$$PAD^BIUTL5(X,27,".")
+19 ;
+20 ;---> Vaccine.
+21 SET X=X_$$VNAME^BIUTL2($PIECE(BI0,U,4))
+22 SET X=$$PAD^BIUTL5(X,39,".")
+23 ;
+24 ;---> Active/Inactive.
+25 SET X=X_$SELECT($PIECE(BI0,U,3)=1:"Inactive",1:"Active")
+26 SET X=$$PAD^BIUTL5(X,47,".")
+27 ;
+28 ;---> Expiration Date.
+29 IF $PIECE(BI0,U,9)
SET X=X_$$LOTEXP^BIRPC3(BIIEN,1)
+30 SET X=$$PAD^BIUTL5(X,57,".")
+31 ;
+32 ;---> Starting Count.
+33 IF $PIECE(BI0,U,11)
SET X=X_$JUSTIFY($PIECE(BI0,U,11),5)
+34 SET X=$$PAD^BIUTL5(X,64,".")
+35 ;
+36 ;---> Doses Unused (amount left).
+37 IF $PIECE(BI0,U,11)
SET X=X_$JUSTIFY($$LOTRBAL^BIRPC3(BIIEN),5)
+38 SET X=$$PAD^BIUTL5(X,71,".")
+39 ;
+40 ;---> Facility (if entered).
+41 IF $PIECE(BI0,U,14)
SET X=X_$EXTRACT($$INSTTX^BIUTL6($PIECE(BI0,U,14)),1,8)
+42 SET X=$$PAD^BIUTL5(X,80,".")
+43 ;
+44 ;---> Set this Vaccine display row and index in ^TMP.
+45 DO WRITE(.BILINE,X,,BIENT)
+46 QUIT
+47 ;
+48 ;
+49 ;----------
WRITE(BILINE,BIVAL,BIBLNK,BIENT) ;EP
+1 ;---> Write lines to ^TMP (see documentation in ^BIW).
+2 ;---> Parameters:
+3 ; 1 - BILINE (ret) Last line# written.
+4 ; 2 - BIVAL (opt) Value/text of line (Null=blank line).
+5 ; 3 - BIBLNK (opt) Number of blank lines to add after line sent.
+6 ; 4 - BIENT (opt) Entry Number for LM selection in VALMY
+7 ;
+8 IF '$DATA(BILINE)
QUIT
+9 DO WL^BIW(.BILINE,"BILOT",$GET(BIVAL),$GET(BIBLNK),$GET(BIENT))
+10 QUIT
+11 ;
+12 ;
+13 ;----------
EDITLOT(BINEW) ;EP
+1 ;---> Edit a Lot Number.
+2 ;---> Parameters:
+3 ; 2 - BINEW (opt) 1=new lot number being added; 0/""=edit.
+4 ;
+5 ;---> Steps:
+6 ; 1) This entry point is called by the Protocol:
+7 ; BI LOT NUMBER SELECT, an action on the
+8 ; List Manager menu protocol: BI MENU LOT NUMBER EDIT.
+9 ;
+10 ; 2) This code calls ScreenMan form:
+11 ; BI FORM-LOT NUMBER EDIT to build BI local array
+12 ; of data for add/edit of a Lot Number.
+13 ; Data already stored in the BI local array is loaded
+14 ; into the form by LOADLOT^BILOT1, which is called
+15 ; by the Pre-Action of Block for Vaccine Edit.
+16 ;
+17 ; 3) Use BI local array to send data to FDIE^BIFMAN.
+18 ;
+19 ;---> If BINEW, add a new Lot Number and quit.
+20 IF $GET(BINEW)
DO EDITSCR(,1)
DO RESET
QUIT
+21 ;
+22 ;---> Call the Listmanager Generic Selector of items displayed.
+23 NEW VALMY
+24 DO EN^VALM2(XQORNOD(0),"OS")
+25 ;
+26 ;---> Check that a Listman Item was passed.
+27 IF '$DATA(VALMY)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+28 ;---> Now set Y=Item# selected from the list.
+29 NEW Y
SET Y=$ORDER(VALMY(0))
+30 IF '$GET(Y)
DO ERRCD^BIUTL2(406,,1)
DO RESET
QUIT
+31 IF $GET(BILOT(Y))=""
DO ERRCD^BIUTL2(511,,1)
DO RESET
QUIT
+32 DO EDITSCR(+BILOT(Y))
+33 DO FULL^VALM1
+34 DO RESET
+35 QUIT
+36 ;
+37 ;
+38 ;----------
EDITSCR(BILOT,BINEW) ;EP
+1 ;---> Add or edit the fields of a Lot Number.
+2 ;---> (Make this an RPC in the future?)
+3 ;---> Parameters:
+4 ; 1 - BILOT (opt) Lot Number IEN.
+5 ; 2 - BINEW (opt) 1=new lot number being added; 0=edit.
+6 ;
+7 ;---> If this is an edit, check that IEN of Lot Number.
+8 IF '$GET(BINEW)
IF $GET(^AUTTIML(+$GET(BILOT),0))=""
DO ERRCD^BIUTL2(511,,1)
QUIT
+9 ;
+10 ;---> If this is an edit, preload existing values for Screenman form.
+11 NEW BI
IF $GET(BILOT)
Begin DoDot:1
+12 NEW Y
SET Y=^AUTTIML(BILOT,0)
+13 ;Full Lot Number Text.
SET BI("AS")=$PIECE(Y,U,1)
+14 ;Lot Number Text.
SET BI("A")=$PIECE(BI("AS"),"*")
+15 ;Lot Number Text.
SET BI("S")=$PIECE(BI("AS"),"*",2)
+16 ;Vaccine.
SET BI("B")=$PIECE(Y,U,4)
+17 ;Status Active/Inactive.
SET BI("C")=+$PIECE(Y,U,3)
+18 ;Expiration Date.
SET BI("D")=$PIECE(Y,U,9)
+19 ;Starting Count.
SET BI("E")=$PIECE(Y,U,11)
+20 ;Doses Unused.
SET BI("F")=$PIECE(Y,U,12)
+21 ;Low Supply Alert.
SET BI("G")=$PIECE(Y,U,15)
+22 ;Source VFC or NON-VFC.
SET BI("H")=$PIECE(Y,U,13)
+23 ;Manufacturer.
SET BI("M")=$PIECE(Y,U,2)
+24 ;Facility.
SET BI("N")=$PIECE(Y,U,14)
+25 ;NDC Code.
SET BI("O")=$PIECE(Y,U,17)
End DoDot:1
+26 ;
+27 ;---> Call Screenman to build BI local array of data by user.
+28 NEW BISAVE
+29 NEW DR
SET DR="[BI FORM-LOT NUMBER EDIT]"
+30 DO DDS^BIFMAN(9999999.41,DR,$GET(BILOT),"S",.BISAVE,.BIPOP)
+31 ;
+32 ;---> Quit if user did not save this data.
+33 IF ('$GET(BISAVE))
QUIT
+34 ;
+35 ;---> Build local array for this Lot Number.
+36 NEW BIERR,BIFLD
+37 SET BI("AS")=BI("A")
+38 IF $GET(BI("S"))]""
SET BI("AS")=BI("AS")_"*"_BI("S")
+39 ;
+40 ;---> v8.5: If Active Status="", set it to 0, so PCC will be happy.
+41 IF $GET(BI("C"))=""
SET BI("C")=0
+42 ;
+43 SET BIFLD(.01)=$GET(BI("AS"))
SET BIFLD(.03)=$GET(BI("C"))
SET BIFLD(.09)=$GET(BI("D"))
+44 SET BIFLD(.11)=$GET(BI("E"))
SET BIFLD(.12)=$GET(BI("F"))
SET BIFLD(.15)=$GET(BI("G"))
+45 SET BIFLD(.13)=$GET(BI("H"))
SET BIFLD(.02)=$GET(BI("M"))
SET BIFLD(.14)=$GET(BI("N"))
+46 SET BIFLD(.16)=$GET(BI("A"))
SET BIFLD(.17)=$GET(BI("O"))
+47 ;---> If this is a new Lot Number, include the Vaccine.
+48 IF $GET(BINEW)
SET BIFLD(.04)=$GET(BI("B"))
+49 ;
+50 ;
+51 ;---> If this is a new Lot Number and it already exists (not a sub-lot),
+52 ;---> then display error and quit.
+53 IF $GET(BINEW)
IF $DATA(^AUTTIML("B",BI("AS")))
Begin DoDot:1
+54 DO CLEAR^VALM1
DO FULL^VALM1
DO TITLE^BIUTL5("EDIT LOT NUMBER FIELDS")
+55 WRITE !!?23,"This Lot Number already exists!"
+56 WRITE !!?18,"Please exit and select it from the list."
+57 WRITE !!!!?5,"NOTE: It It may be Inactive. Try displaying Inactive Lot Numbers"
+58 WRITE !?11,"as well as Active ones.",!
+59 DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+60 ;
+61 ;
+62 ;---> Add/update the Lot Number.
+63 Begin DoDot:1
+64 IF $GET(BINEW)
DO UPDATE^BIFMAN(9999999.41,.BILOT,.BIFLD,.BIERR)
QUIT
+65 DO FDIE^BIFMAN(9999999.41,BILOT,.BIFLD,.BIERR)
End DoDot:1
+66 ;
+67 ;---> If there was an error, display it.
+68 IF $GET(BIERR)]""
Begin DoDot:1
+69 DO CLEAR^VALM1
DO FULL^VALM1
DO TITLE^BIUTL5("EDIT LOT NUMBER FIELDS")
+70 WRITE !!?3,BIERR
DO DIRZ^BIUTL3()
End DoDot:1
QUIT
+71 ;
+72 QUIT
+73 ;
+74 ;
+75 ;----------
LOADLOT ;EP
+1 ;---> Code to load Lot Number data for ScreenMan Edit form.
+2 ;---> Called by Pre Action of Block BI BLK-LOT NUMBER EDIT on
+3 ;---> Form BI FORM-LOT NUMBER EDIT.
+4 ;
+5 ;---> If this is a NEW Lot Number, enable editing of Vaccine, Field 2.
+6 IF $GET(BINEW)
DO UNED^DDSUTL(2,,,0)
+7 ;
+8 ;---> Load Lot Number.
+9 IF $GET(BI("A"))]""
DO PUT^DDSVALF(1,,,BI("A"),"I")
+10 ;
+11 ;---> Load Sub-lot, if it exists.
+12 IF $GET(BI("S"))]""
DO PUT^DDSVALF(1.5,,,BI("S"),"I")
+13 ;
+14 ;---> Load Vaccine Name (.01).
+15 IF $GET(BI("B"))]""
DO PUT^DDSVALF(2,,,BI("B"),"I")
+16 ;
+17 ;---> Load Vaccine Short Name (.02).
+18 IF $GET(BI("B"))]""
DO PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BI("B"))_")")
+19 ;
+20 ;---> Load Lot Number Status Active/Inactive.
+21 IF $GET(BI("C"))]""
DO PUT^DDSVALF(3,,,BI("C"),"I")
+22 ;
+23 ;---> Load Lot Number Expiration Date.
+24 IF $GET(BI("D"))]""
DO PUT^DDSVALF(4,,,BI("D"),"I")
+25 ;
+26 ;---> Load the Starting Count.
+27 IF $GET(BI("E"))]""
DO PUT^DDSVALF(5,,,BI("E"),"I")
+28 ;
+29 ;---> Load the Doses Unused.
+30 IF $GET(BI("F"))]""
DO PUT^DDSVALF(6,,,BI("F"),"I")
+31 ;
+32 ;---> Load the Low Supply Alert.
+33 IF $GET(BI("G"))]""
DO PUT^DDSVALF(7,,,BI("G"),"I")
+34 ;
+35 ;---> Load the Source (VFC or NON-VFC).
+36 IF $GET(BI("H"))]""
DO PUT^DDSVALF(11,,,BI("H"),"I")
+37 ;
+38 ;---> Load Manufacturer.
+39 IF $GET(BI("M"))]""
DO PUT^DDSVALF(10,,,BI("M"),"I")
+40 ;
+41 ;---> Load Facility.
+42 IF $GET(BI("N"))]""
DO PUT^DDSVALF(9,,,BI("N"),"I")
+43 ;
+44 ;---> Load NDC Code.
+45 IF $GET(BI("O"))]""
DO PUT^DDSVALF(4.5,,,BI("O"),"I")
+46 ;
+47 ;---> Calculate the number of doses that have been used.
+48 DO CALCDOS($GET(BI("E")),$GET(BI("F")))
+49 QUIT
+50 ;
+51 ;
+52 ;----------
INVOFF(BIZ) ;EP
+1 ;---> Trigger Popup that Doses Unused cannot be greater than
+2 ;---> the Starting Count.
+3 ;---> Called from Fields 5 & 6 on Form BI FORM-LOT NUMBER EDIT.
+4 ;---> Parameters:
+5 ; 1 - BIZ (req) Field triggered from: 1=Starting Count
+6 ; 2=Doses Unused
+7 ;
+8 IF '$GET(BIZ)
QUIT
+9 SET DDSSTACK="BI PAGE-INVENTORY OFF"
+10 IF BIZ=1
DO PUT^DDSVALF(5,,,$GET(DDSOLD),"I")
QUIT
+11 IF BIZ=2
DO PUT^DDSVALF(6,,,$GET(DDSOLD),"I")
QUIT
+12 QUIT
+13 ;
+14 ;
+15 ;----------
CALCDOS(E,F) ;EP
+1 ;---> Calculate the number of doses of a Lot Number that have been used.
+2 ;---> Called from Fields 5 & 6 on Form BI FORM-LOT NUMBER EDIT.
+3 ;---> Parameters:
+4 ; 1 - E (req) Starting Count
+5 ; 2 - F (req) Doses Unused
+6 ;
+7 IF ($GET(E)="")
QUIT
IF ($GET(F)="")
QUIT
+8 DO PUT^DDSVALF(8,,,(E-F),"I")
+9 QUIT
+10 ;
+11 ;
+12 ;----------
VACINA1 ;EP
+1 ;---> Trigger Popup that says vaccine must be Active.
+2 ;---> Called from Fields 2 on Form BI FORM-LOT NUMBER EDIT.
+3 ;
+4 ;---> If this vaccine is Inactive, display popup.
+5 ;---> Ex
+6 IF $PIECE($GET(^AUTTIMM(+X,0)),U,7)
Begin DoDot:1
+7 SET DDSSTACK="BI PAGE-INACTIVE VACCINE"
End DoDot:1
QUIT
+8 ;
+9 SET BINEW(1)=1
SET DDSBR=10
+10 IF $GET(X)
SET BI("B")=X
DO PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(X)_")")
+11 QUIT
+12 ;
+13 ;
+14 ;----------
VACINA2 ;EP
+1 ;---> Called from Fields 3 on Form BI FORM-LOT NUMBER EDIT.
+2 ;---> If no vaccine was selected, send user back to Field 2 (vaccine).
+3 IF '$GET(BI("B"))
SET DDSBR=2
Begin DoDot:1
+4 ;D HLP^DDSUTL("Select the Vaccine that corresponds to this Lot Number.")
End DoDot:1
QUIT
+5 ;
+6 NEW BIT
SET BIT="Select whether this Lot Number should be Active or Inactive."
+7 SET BIT=BIT_" Note that users will not be able to select an Inactive Lot "
+8 SET BIT=BIT_"Number if the Category is Ambulatory."
+9 DO HLP^DDSUTL(BIT)
+10 QUIT
+11 ;
+12 ;
+13 ;----------
VACINA3 ;EP
+1 ;---> After code from popup, going back to Form BI FORM-LOT NUMBER EDIT.
+2 ;---> To get there: Get to the form (above), press F1-P, then page 5,
+3 ;---> then F1-V, tab to BI BLK-..., spacebar, F4, Post Action at the bottom.
+4 ;
+5 ;---> Kill the vaccine node, null out the display of vaccine names.
+6 KILL BI("B")
DO PUT^DDSVALF(2,2,1,,"E")
DO PUT^DDSVALF(2.5,2,1,,"E")
+7 QUIT
+8 ;
+9 ;
+10 ;----------
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^BILOT
DO HDR^BILOT()
+5 QUIT
+6 ;
+7 ;
+8 ;----------
CHGORDR ;EP
+1 ;
+2 DO CHGORDR^BILOT2
+3 QUIT
+4 ;
+5 ;
+6 ;----------
TEXT2 ;EP
+1 ;;
+2 ;;The Lot Number Table will always be listed with the group of
+3 ;;all ACTIVE Lot Numbers first, followed by all INACTIVE Lot Numbers.
+4 ;;However, within those two groups you may select the order in which
+5 ;;the Lot Numbers are displayed, as follows:
+6 ;;
+7 ;; 1) By Unused Doses (least first)
+8 ;; 2) By Expiration Date
+9 ;; 3) By Lot Number
+10 ;; 4) By Vaccine Name, then by Unused Doses
+11 ;; 5) By Vaccine Name, then by Exp Date
+12 ;; 6) By Vaccine Name, then by Lot Number
+13 ;;
+14 DO PRINTX("TEXT2")
+15 QUIT
+16 ;
+17 ;
+18 ;----------
INACTA ;EP
+1 ;---> Automatically Inactivate old Lot Numbers that either have expired
+2 ;---> or have no Expiration Date.
+3 ;
+4 DO FULL^VALM1
DO TITLE^BIUTL5("INACTIVATE OLD LOT NUMBERS")
DO TEXT3^BILOT
+5 NEW DIR,Y
DO INACTA1
+6 DO ^DIR
+7 IF $DATA(DIRUT)
SET BIPOP=1
+8 IF Y'=1
Begin DoDot:1
+9 WRITE !!?5,"Okay. NO changes made!"
DO DIRZ^BIUTL3()
+10 DO RESET
End DoDot:1
QUIT
+11 ;
+12 DO TITLE^BIUTL5("INACTIVATE OLD LOT NUMBERS")
DO TEXT33^BILOT
DO INACTA1
+13 DO ^DIR
+14 IF $DATA(DIRUT)
SET BIPOP=1
+15 IF Y'=1
Begin DoDot:1
+16 WRITE !!?5,"Okay. NO changes made!"
DO DIRZ^BIUTL3()
+17 DO RESET
End DoDot:1
QUIT
+18 ;
+19 DO INACTLN
+20 DO RESET
+21 QUIT
+22 ;
+23 ;
+24 ;----------
INACTA1 ;EP
+1 ;---> Set DIR values for linelabel INACTA.
+2 SET DIR(0)="YA"
+3 SET DIR("A")=" Please answer either YES or NO: "
SET DIR("B")="NO"
+4 SET DIR("?",1)=" Enter YES to automatically Inactivate Lot Numbers, "
+5 SET DIR("?")=" enter NO to make no changes."
+6 QUIT
+7 ;
+8 ;
+9 ;----------
INACTLN ;EP
+1 ;---> Inactivate all Lot Numbers that either have expired or have
+2 ;---> no Expiration Date.
+3 ;
+4 DO ^XBKVAR
+5 NEW M,N
SET M=0
SET N=0
+6 FOR
SET N=$ORDER(^AUTTIML(N))
IF 'N
QUIT
Begin DoDot:1
+7 IF '$DATA(^AUTTIML(N,0))
QUIT
+8 ;---> Do not Inactivate if Exp Date is later than Today.
+9 IF ($PIECE(^AUTTIML(N,0),"^",9)>$GET(DT))
QUIT
+10 ;---> Quit if this Lot Number is already Inactive.
+11 IF ($PIECE(^AUTTIML(N,0),"^",3)=1)
QUIT
+12 ;---> Inactivate this Lot Number.
+13 SET $PIECE(^AUTTIML(N,0),"^",3)=1
SET M=M+1
End DoDot:1
+14 WRITE !!?5,"Done. ",M," Lot Numbers have been Inactivated."
DO DIRZ^BIUTL3()
+15 QUIT
+16 ;
+17 ;
+18 ;----------
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 ;----------
NULLACT ;EP
+1 ;---> Activate all Lot Numbers that have a Status=null.
+2 ;---> Call by postinit for Imm v8.5.
+3 ;
+4 DO ^XBKVAR
+5 WRITE !!?5,"Checking Lot Numbers for null Status..."
+6 NEW M,N
SET M=0
SET N=0
+7 FOR
SET N=$ORDER(^AUTTIML(N))
IF 'N
QUIT
Begin DoDot:1
+8 IF '$DATA(^AUTTIML(N,0))
QUIT
+9 ;---> Quit if this lot number has a Status .
+10 IF ($PIECE(^AUTTIML(N,0),"^",3)'="")
QUIT
+11 ;---> Okay, Status must be null, so set it to Active.
+12 SET $PIECE(^AUTTIML(N,0),"^",3)=0
SET M=M+1
End DoDot:1
+13 WRITE !!?5,"Done. ",M," Lot Numbers have been fixed."
DO DIRZ^BIUTL3()
+14 QUIT
