BIUTL4 ;IHS/CMI/MWR - UTIL: SCREENMAN CODE; OCT 15, 2010
;;8.5;IMMUNIZATION;**12**;MAY 01,2016
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; UTILITY: SCREENMAN CODE: VAC SELECT ACTIONS, SERIES VALID,
;; LOC BRANCHING LOGIC, VISIT LOC DEF, SKIN TEST READ MM.
;; PATCH 2: Comment out code that would disable VFC Elig field for
; patients >19yrs. OLDDATE+15
;; PATCH 5: Add NDC to reset fields when vaccine is changed. VACCHG+14
;; PATCH 5: Add leading zero to default volume if less than 1. VISVOL+21
;; PATCH 9: Make VIS Presented Date default to Visit Date (when changed). OLDATE+9
;; PATCH 10: Only stuff VIS Presented Date if this is a V Imm. OLDDATE+18
;; PATCH 12: If date not today, Inj Site not required OLDDATE+17
;
;----------
VACSCR ;EP
;---> Set Screen for vaccine selection in Screen field of
;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
;---> when selecting vaccine.
;---> Screen: If this vaccine is Active OR if this is an Historical Event
;---> AND this is NOT a Skin Test.
;
S DIR("S")="I ('$P(^AUTTIMM(Y,0),U,7)!($G(BI(""I""))=""E""))"
S DIR("S")=DIR("S")_"&('$P(^AUTTIMM(Y,0),U,8))"
Q
;
;
;----------
VACSEL(BIVAC) ;EP
;---> For IMMUNIZATIONS:
;---> Actions to take in Screenman when Vaccine is selected.
;---> Called by the POST ACTION of Field 2, Vaccine
;---> of the Form BI FORM-IMM VISIT ADD/EDIT.
;---> Parameters:
; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
;
;---> Display Vaccine Short Name below Vaccine Name.
Q:('$G(BIVAC))
S BI("B")=BIVAC
D PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BIVAC)_")")
Q
;
;
;----------
VACSELC(BIVAC) ;EP
;---> For CONTRAINDICATIONS:
;---> Actions to take in Screenman when Vaccine is selected.
;---> Called by the POST ACTION of Field 2, Vaccine
;---> of the Form BI FORM-CONTRAINDICATION ADD.
;---> Parameters:
; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
;
;---> If a vaccine has not been chosen, then disable the Reason field.
I '$G(BIVAC) D Q
.D HLP^DDSUTL("You must first choose a vaccine."),HLP^DDSUTL("$$EOP")
.;---> Make Reason uneditable.
.D UNED^DDSUTL(4,,,1)
;
;---> Make Reason editable.
D UNED^DDSUTL(4,,,0)
;---> Display Vaccine Short Name below Vaccine Name.
S BI("B")=BIVAC
D PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BIVAC)_")")
Q
;
;
;----------
VACCHG(BIVAC) ;EP
;---> Actions to take in Screenman when the Vaccine is selected
;---> or changed.
;---> Called by the POST ACTION ON CHANGE of Field 2, Vaccine"
;---> of the Form BI FORM-IMM VISIT ADD/EDIT.
;---> Parameters:
; 1 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
;
Q:'$G(BIVAC)
;
;---> If this is NOT a new visit, inform user that Dose#, Lot#,
;---> Reaction, and VIS will be deleted and replaced.
D:$G(BI("K"))
.N BIMSG
.;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
.;---> Add NDC to reset fields when vaccine is changed.
.S BIMSG="* NOTE: Because you have changed the vaccine, Dose Override,"
.S BIMSG=BIMSG_"Lot#, NDC, and any Reaction and VIS will be removed or replaced"
.S BIMSG=BIMSG_" with defaults for the new vaccine."
.D HLP^DDSUTL(BIMSG),HLP^DDSUTL("$$EOP")
;
;---> Clear data relating to previous Vaccine (if any).
D PUT^DDSVALF(3) S BI("D")="" ;Lot# IEN
D PUT^DDSVALF(13) S BI("O")="" ;Reaction
D PUT^DDSVALF(10) S BI("Q")="" ;VIS
D PUT^DDSVALF(14) S BI("S")="" ;Dose Override
D PUT^DDSVALF(5) S BI("W")="" ;Volume
D PUT^DDSVALF(3.8) S BI("H")="" ;NDC
;**********
;
;---> If Category is Historical Event, do not stuff Lot# and VIS defaults.
Q:$G(BI("I"))="E"
;
;---> If this Vaccine has a Default ("Current") Lot#, then stuff it.
N BIX
I '$G(BI("D")) D
.S BIX=$$LOTDEF^BIUTL2(BIVAC)
.I BIX D PUT^DDSVALF(3,,,BIX,"I") S BI("D")=BIX
;
D VISVOL(BIVAC)
Q
;
;
;----------
VISVOL(BIVAC) ;EP
;---> Stuff VIS and Volume defaults for a Lot Number on
;---> the Form BI FORM-IMM VISIT ADD/EDIT.
;---> Parameters:
; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
;
Q:'$G(BIVAC)
N BIX
;---> If this Vaccine has a Default VIS, stuff it.
D:'$G(BI("Q"))
.S BIX=$$VISDEF^BIUTL2(BIVAC)
.I BIX D PUT^DDSVALF(10,,,BIX,"I") S BI("Q")=BIX
;
;---> If this is a new visit, stuff Volume Default.
D:'$G(BI("K"))
.N X S X=$$CODE^BIUTL2(BIVAC,5)
.Q:'X
.;---> For Influenza CVX 15, if patient is <36 mths change default=.25 ml.
.D:BIVAC=148
..Q:'$G(BIDFN) S:$$AGE^BIUTL1(BIDFN)<36 X=".25"
.;
.;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
.;---> Add leading zero to default volume if less than 1.
.S:(X<1) X="0"_X
.;**********
.S BI("W")=X D PUT^DDSVALF(5,,,BI("W"),"I")
;
Q
;
;
;----------
LOTDUP(BILIEN) ;EP
;---> Return 1 if the Lot# has a duplicate in the IMMUNIZATION LOT
;---> File; 0 if it is unique.
;---> Parameters:
; 1 - BILIEN (req) IEN of Lot# in IMMUNIZATION LOT File.
;
Q:'$G(BILIEN) 0
Q:'$D(^AUTTIML(BILIEN,0)) 0
;
;---> If Lot# is duplicated in the IMM LOT File, return 1.
N Y,Z S Y=$P(^AUTTIML(BILIEN,0),U) S Z=$O(^AUTTIML("B",Y,0))
Q:$O(^AUTTIML("B",Y,Z)) 1
;---> Lot# is unique, return 0.
Q 0
;
;
;----------
LOTHELP(BILIEN) ;EP
;---> If chosen Lot# is a duplicate, provide help message.
;---> Parameters:
; 1 - BILIEN (req) IEN of Lot# in IMMUNIZATION LOT File.
N BIPOP,X
Q:'$$LOTDUP(BILIEN)
;
D TITLE^BIUTL5("DUPLICATE LOT NUMBERS")
S X="--> Lot# "_$$LOTTX^BIUTL6(BILIEN)_" <--" D CENTERT^BIUTL5(.X)
W X,!
D
.I $$MAYMANAG^BIUTL11 D Q
..D TEXT2^BIUTL6,DIRZ^BIUTL3(.BIPOP)
..Q:$G(BIPOP)
..D TITLE^BIUTL5("DUPLICATE LOT NUMBERS"),TEXT3^BIUTL6
.D TEXT1^BIUTL6
D:'$G(BIPOP) DIRZ^BIUTL3()
D REFRESH^DDSUTL
S BI("D")="",DDSBR=3 D PUT^DDSVALF(3)
Q
;
;
;----------
LOTSCR ;EP
;---> Set Screen for Lot Number selection in Screen field of
;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
;---> when selecting Lot Number.
;---> Screen: If this Lot Number is Active, AND if no Vaccine has been selected OR
;---> this Lot Number is assigned to the selected Vaccine,
;---> AND if EITHER [it has no specific Location] OR
;---> [its Location matches the user's Location (DUZ(2))].
;
N BILOC S BILOC=$P($G(^AUTTIML(+Y,0)),U,14)
;
;---> Next line: Concat to avoid suspected naked ref.
S DIR("S")="I $P(^"_"(0),U,3)=0,($G(BI(""B""))=""""!$D(^AUTTIML(""C"",+$G(BI(""B"")),Y)))"
S DIR("S")=DIR("S")_",(('$P($G(^AUTTIML(Y,0)),U,14))!($P($G(^AUTTIML(Y,0)),U,14)=$G(DUZ(2))))"
Q
;
;
;----------
LOTSEL(BIX) ;EP
;---> Action to take after Lot Number has been selected.
;---> Parameters:
; 1 - BIX (req) X=Internal Value of Lot Number selected.
;
;---> Executed from the "POST ACTION ON CHANGE" field of the
;---> "Form ONly Field Properties" of the Form BI FORM-IMM VISIT ADD/EDIT.
;
;---> Action: If a Vaccine was not chosen, but instead a Lot Number was entered first,
;---> then populate the Vaccine field on the form (which triggers VACCHG above).
;
Q:'BIX
;
D
.;---> Don't change the Vaccine if it has already been selected.
.Q:(+$G(BI("B")))
.;---> Stuff Vaccine IEN for this Lot Number.
.N BIVAC S BIVAC=$$LOTTX^BIUTL6(BIX,1)
.D PUT^DDSVALF(2,,,BIVAC,"I")
.D VACSEL(BIVAC)
.D LOTWARN^BIUTL7($G(BI("D")),$G(BI("E")),$G(BI("F")))
.D VISVOL(BIVAC)
;
D
.;---> Stuff default NDC IEN for this Lot Number.
.Q:(+$G(BI("H")))
.N BINDC S BINDC=$$LOTTX^BIUTL6(BIX,3)
.I BINDC D PUT^DDSVALF(3.8,,,BINDC,"I")
;
Q
;
;
;----------
NDCSCR ;EP
;---> Set Screen for NDC Code selection in Screen field of
;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
;---> when selecting NDC Code.
;---> Screen: If this NDC is Active, AND this NDC is assigned to the selected
;---> vaccine in BI("B").
;
;W !!,"This screen in NDCSCR^BIUTL4",! X ^O
S DIR("S")="I $P(^BINDC(Y,0),U,6)'=1,$D(^BINDC(""C"",+$G(BI(""B"")),Y))"
Q
;
;
;----------
CREASCR ;EP
;---> Set Screen for Contraindication Reason selection in Reason field
;---> "Form Only Field Parameters" of the Form BI FORM-CONTRAINDICATION ADD.
;---> Screen: If this Reason is Active AND if this Reason is Skin Test
;---> related AND this Vaccine is a Skin Test.
;
;---> If no vaccine chosen, then screen says all reasons are invalid.
I '$G(BI("B")) S DIR("S")="I 0" Q
;
S DIR("S")="I ($P(^BICONT(Y,0),U,3))&(+$P(^BICONT(Y,0),U,4)"
S DIR("S")=DIR("S")_"=+$P(^AUTTIMM(BI(""B""),0),U,8))"
Q
;
;
;----------
HISTORY(X) ;EP
;---> See BIUTL9.
D HISTORY^BIUTL9(X)
Q
;
;
;----------
OLDDATE(X) ;EP
;---> Add/Edit Screenman actions to take ON POST-CHANGE of Date Field.
;---> If date entered is earlier than today, Category default changes to
;---> Historical. If the date is more than 5 days earlier than today,
;---> user as default Provider is removed.
;---> Parameters:
; 1 - X (opt) X=Internal Value of Date of Visit entered.
;
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Make VIS Presented Date default to Visit Date (when changed).
N BIDATEE S BIDATEE=X
;
I '$G(BI("K"))&($P(X,".")'=DT) D
.D PUT^DDSVALF(11,,,"E","I") S BI("I")="E"
.I ($G(DT)-X)>5 D NOPROV^BIUTL7("E")
.;
.;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
.;---> If Date not today, set Injection Site and Volume fields not required.
.D REQ^DDSUTL(4,"","",0),REQ^DDSUTL(5,"","",0)
;
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
;---> Only stuff VIS Presented Date if this is a V Imm.
;D PUT^DDSVALF(10.2,,,BIDATEE,"E") S BI("QQ")=BIDATEE
I $G(BIVTYPE)="I" D PUT^DDSVALF(10.2,,,BIDATEE,"E") S BI("QQ")=BIDATEE
;
;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
;---> Insert missing Q.
Q
;**********
;
;
;----------
SKINCHG(BISKIEN) ;EP
;---> Actions to take in Screenman when the Skin Test is selected
;---> or changed.
;---> Called by the POST ACTION ON CHANGE of Field 2, Skin Test"
;---> of the Form BI FORM-SKIN VISIT ADD/EDIT.
;---> Parameters:
; 1 - BISKIEN (opt) IEN of Vaccine IMMUNIZATION File (9999999.14).
; (Not used for now.)
Q:'$G(BISKIEN)
;
;---> If this is NOT a new visit, inform user that Dose#, Lot#,
;---> Reaction, and VIS will be deleted and replaced.
D:$G(BI("K"))
.N BIMSG
.S BIMSG="* NOTE: Because you have changed the Skin Test, the Result,"
.S BIMSG=BIMSG_" Reading, Date of Reading, and Reader will be removed."
.D HLP^DDSUTL(BIMSG),HLP^DDSUTL("$$EOP")
;
;---> Clear data relating to previous Skin Test (if any).
D PUT^DDSVALF(3) S BI("L")="" ;Result
D PUT^DDSVALF(4) S BI("M")="" ;Reading
D PUT^DDSVALF(5) S BI("N")="" ;Date of Reading
D PUT^DDSVALF(10) S BI("X")="" ;Reader
Q
;
;
;----------
SERVAL(BIDOSE,BIVAC) ;EP
;---> Validate Dose# for this Immunization Visit.
;---> Parameters:
; 1 - BIDOSE (req) Dose# entered by the user.
; 2 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
;
Q:'BIDOSE Q:'BIVAC
S BIMAX=$$VMAX^BIUTL2(BIVAC)
;
;---> If Dose# entered is greater than Max Dose# for this Vaccine,
;---> reject value and display help text.
I BIDOSE>BIMAX S DDSERROR=1 D
.N Z
.S Z="The Maximum Dose# for "_$$VNAME^BIUTL2(BIVAC)_" is "_BIMAX
.S Z=Z_". Please enter a number between 1 and "_BIMAX_"."
.D HLP^DDSUTL(Z)
Q
;
;
;----------
INACTV(X) ;EP
;---> Called by the POST ACTION of Field 4, "Inactive Date"
;---> of the Form BI FORM-CASE DATA EDIT.
;---> Actions to take in Screenman when Patient is made Inactive
;---> by adding a date to Field 4, Inactive Date, of the Form.
;---> Parameters:
; 1 - X (req) Internal value of the date entered.
;
;---> If no Inactive Date entered, set Reason="" and "Moved to"=""
;---> and disable navigation to and editing of the fields.
I '$G(X) D Q
.D PUT^DDSVALF(5),PUT^DDSVALF(5.5)
.D UNED^DDSUTL(5,,,1),UNED^DDSUTL(5.5,,,1)
.S (BI("F"),BI("I"))="@"
;---> A date has been entered, so enable edit and navigation.
D UNED^DDSUTL(5,,,0),UNED^DDSUTL(5.5,,,0)
Q
;
;
;----------
LOCBR ;EP
;---> Location Type branching logic for Add/Edit Imm Visit Form:
;---> "Location" field.
;
;---> If Location Type is "Other":
I (X="O")&($G(DDSOLD)'="O") D
.;
.;---> Disable IHS Loc (7) and put a null value in IHS Loc (7).
.D UNED^DDSUTL(7,,,1),PUT^DDSVALF(7)
.;
.;---> Set IHS Location IEN in BI array =null (ADD+18^BIVISIT).
.S BI("F")=""
.;
.;---> Enable Other Loc (8).
.D UNED^DDSUTL(8,,,0)
.;
.;---> Make Other Loc required, and IHS Loc not required.
.D REQ^DDSUTL(8,,,1),REQ^DDSUTL(7,,,0)
;
;
;---> If Location Type is "IHS":
I (X="I")&($G(DDSOLD)'="I") D
.;
.;---> Disable Other Loc (8) and put a null value in Other Loc (8).
.D UNED^DDSUTL(8,,,1),PUT^DDSVALF(8)
.;
.;---> Set Outside Location text in BI array =null (ADD+19^BIVISIT).
.S BI("G")=""
.;
.;---> Enable IHS Loc (7).
.D UNED^DDSUTL(7,,,0)
.;
.;---> Make IHS Loc required, and Other Loc not required.
.D REQ^DDSUTL(7,,,1),REQ^DDSUTL(8,,,0),DEFSITE
Q
;
;
;----------
VISDATE ;EP
;---> Enable/disable and if necessary clear VIS Date, based on
;---> YES/NO answer of VIS Given question.
;
;---> If VIS Given=YES (1), then enable editing of VIS Date.
I X=1 D Q
.D UNED^DDSUTL(13,,,0)
.;---> If no VIS Date present, get default from IMMUNIZATION File.
.Q:$$GET^DDSVALF(13)
.N BIY S BIY=$$GET^DDSVALF(2)
.D PUT^DDSVALF(13,,,$$VISDEF^BIUTL2(BIY))
;
;---> Otherwise, stuff null in VIS Date and make it uneditable.
D PUT^DDSVALF(13) S BI("Q")=""
D UNED^DDSUTL(13,,,1)
Q
;
;
;----------
DEFSITE ;EP
;---> Code to stuff default Location of Visit in Add/Edit Imm Visit
;---> form. If Location Type is IHS and current value is null,
;---> stuff user's DUZ(2) as default.
;
Q:$$GET^DDSVALF(6)'="I"
Q:$$GET^DDSVALF(7)]""
D PUT^DDSVALF(7,"","",DUZ(2),"I")
Q
;
;
;----------
BADREAD ;EP
;---> Code to check Skin Test results: If the result is Negative,
;---> the Reading must be <15mm; in that case,
;---> display help message and reject value.
;
N X
S X="If the result is NEGATIVE, the Reading must be less than 15 millimeters."
D HLP^DDSUTL(X)
S DDSERROR=""
Q
;
;
;----------
BADRDAT ;EP
;---> If the Read Date is earlier than the initial visit date or later
;---> than today, advise and return to Read Date field.
;
I Y<$$GET^DDSVALF(1) S DDSERROR="" D Q
.D HLP^DDSUTL(" * Date of Reading may not be prior to date of initial visit.")
I Y>DT S DDSERROR="" D Q
.D HLP^DDSUTL(" * Date of Reading may not be later than today.")
Q
BIUTL4 ;IHS/CMI/MWR - UTIL: SCREENMAN CODE; OCT 15, 2010
+1 ;;8.5;IMMUNIZATION;**12**;MAY 01,2016
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; UTILITY: SCREENMAN CODE: VAC SELECT ACTIONS, SERIES VALID,
+4 ;; LOC BRANCHING LOGIC, VISIT LOC DEF, SKIN TEST READ MM.
+5 ;; PATCH 2: Comment out code that would disable VFC Elig field for
+6 ; patients >19yrs. OLDDATE+15
+7 ;; PATCH 5: Add NDC to reset fields when vaccine is changed. VACCHG+14
+8 ;; PATCH 5: Add leading zero to default volume if less than 1. VISVOL+21
+9 ;; PATCH 9: Make VIS Presented Date default to Visit Date (when changed). OLDATE+9
+10 ;; PATCH 10: Only stuff VIS Presented Date if this is a V Imm. OLDDATE+18
+11 ;; PATCH 12: If date not today, Inj Site not required OLDDATE+17
+12 ;
+13 ;----------
VACSCR ;EP
+1 ;---> Set Screen for vaccine selection in Screen field of
+2 ;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
+3 ;---> when selecting vaccine.
+4 ;---> Screen: If this vaccine is Active OR if this is an Historical Event
+5 ;---> AND this is NOT a Skin Test.
+6 ;
+7 SET DIR("S")="I ('$P(^AUTTIMM(Y,0),U,7)!($G(BI(""I""))=""E""))"
+8 SET DIR("S")=DIR("S")_"&('$P(^AUTTIMM(Y,0),U,8))"
+9 QUIT
+10 ;
+11 ;
+12 ;----------
VACSEL(BIVAC) ;EP
+1 ;---> For IMMUNIZATIONS:
+2 ;---> Actions to take in Screenman when Vaccine is selected.
+3 ;---> Called by the POST ACTION of Field 2, Vaccine
+4 ;---> of the Form BI FORM-IMM VISIT ADD/EDIT.
+5 ;---> Parameters:
+6 ; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
+7 ;
+8 ;---> Display Vaccine Short Name below Vaccine Name.
+9 IF ('$GET(BIVAC))
QUIT
+10 SET BI("B")=BIVAC
+11 DO PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BIVAC)_")")
+12 QUIT
+13 ;
+14 ;
+15 ;----------
VACSELC(BIVAC) ;EP
+1 ;---> For CONTRAINDICATIONS:
+2 ;---> Actions to take in Screenman when Vaccine is selected.
+3 ;---> Called by the POST ACTION of Field 2, Vaccine
+4 ;---> of the Form BI FORM-CONTRAINDICATION ADD.
+5 ;---> Parameters:
+6 ; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
+7 ;
+8 ;---> If a vaccine has not been chosen, then disable the Reason field.
+9 IF '$GET(BIVAC)
Begin DoDot:1
+10 DO HLP^DDSUTL("You must first choose a vaccine.")
DO HLP^DDSUTL("$$EOP")
+11 ;---> Make Reason uneditable.
+12 DO UNED^DDSUTL(4,,,1)
End DoDot:1
QUIT
+13 ;
+14 ;---> Make Reason editable.
+15 DO UNED^DDSUTL(4,,,0)
+16 ;---> Display Vaccine Short Name below Vaccine Name.
+17 SET BI("B")=BIVAC
+18 DO PUT^DDSVALF(2.5,,,"("_$$VNAME^BIUTL2(BIVAC)_")")
+19 QUIT
+20 ;
+21 ;
+22 ;----------
VACCHG(BIVAC) ;EP
+1 ;---> Actions to take in Screenman when the Vaccine is selected
+2 ;---> or changed.
+3 ;---> Called by the POST ACTION ON CHANGE of Field 2, Vaccine"
+4 ;---> of the Form BI FORM-IMM VISIT ADD/EDIT.
+5 ;---> Parameters:
+6 ; 1 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
+7 ;
+8 IF '$GET(BIVAC)
QUIT
+9 ;
+10 ;---> If this is NOT a new visit, inform user that Dose#, Lot#,
+11 ;---> Reaction, and VIS will be deleted and replaced.
+12 IF $GET(BI("K"))
Begin DoDot:1
+13 NEW BIMSG
+14 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+15 ;---> Add NDC to reset fields when vaccine is changed.
+16 SET BIMSG="* NOTE: Because you have changed the vaccine, Dose Override,"
+17 SET BIMSG=BIMSG_"Lot#, NDC, and any Reaction and VIS will be removed or replaced"
+18 SET BIMSG=BIMSG_" with defaults for the new vaccine."
+19 DO HLP^DDSUTL(BIMSG)
DO HLP^DDSUTL("$$EOP")
End DoDot:1
+20 ;
+21 ;---> Clear data relating to previous Vaccine (if any).
+22 ;Lot# IEN
DO PUT^DDSVALF(3)
SET BI("D")=""
+23 ;Reaction
DO PUT^DDSVALF(13)
SET BI("O")=""
+24 ;VIS
DO PUT^DDSVALF(10)
SET BI("Q")=""
+25 ;Dose Override
DO PUT^DDSVALF(14)
SET BI("S")=""
+26 ;Volume
DO PUT^DDSVALF(5)
SET BI("W")=""
+27 ;NDC
DO PUT^DDSVALF(3.8)
SET BI("H")=""
+28 ;**********
+29 ;
+30 ;---> If Category is Historical Event, do not stuff Lot# and VIS defaults.
+31 IF $GET(BI("I"))="E"
QUIT
+32 ;
+33 ;---> If this Vaccine has a Default ("Current") Lot#, then stuff it.
+34 NEW BIX
+35 IF '$GET(BI("D"))
Begin DoDot:1
+36 SET BIX=$$LOTDEF^BIUTL2(BIVAC)
+37 IF BIX
DO PUT^DDSVALF(3,,,BIX,"I")
SET BI("D")=BIX
End DoDot:1
+38 ;
+39 DO VISVOL(BIVAC)
+40 QUIT
+41 ;
+42 ;
+43 ;----------
VISVOL(BIVAC) ;EP
+1 ;---> Stuff VIS and Volume defaults for a Lot Number on
+2 ;---> the Form BI FORM-IMM VISIT ADD/EDIT.
+3 ;---> Parameters:
+4 ; 1 - BIVAC (req) IEN of Vaccine in IMM File (9999999.14).
+5 ;
+6 IF '$GET(BIVAC)
QUIT
+7 NEW BIX
+8 ;---> If this Vaccine has a Default VIS, stuff it.
+9 IF '$GET(BI("Q"))
Begin DoDot:1
+10 SET BIX=$$VISDEF^BIUTL2(BIVAC)
+11 IF BIX
DO PUT^DDSVALF(10,,,BIX,"I")
SET BI("Q")=BIX
End DoDot:1
+12 ;
+13 ;---> If this is a new visit, stuff Volume Default.
+14 IF '$GET(BI("K"))
Begin DoDot:1
+15 NEW X
SET X=$$CODE^BIUTL2(BIVAC,5)
+16 IF 'X
QUIT
+17 ;---> For Influenza CVX 15, if patient is <36 mths change default=.25 ml.
+18 IF BIVAC=148
Begin DoDot:2
+19 IF '$GET(BIDFN)
QUIT
IF $$AGE^BIUTL1(BIDFN)<36
SET X=".25"
End DoDot:2
+20 ;
+21 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+22 ;---> Add leading zero to default volume if less than 1.
+23 IF (X<1)
SET X="0"_X
+24 ;**********
+25 SET BI("W")=X
DO PUT^DDSVALF(5,,,BI("W"),"I")
End DoDot:1
+26 ;
+27 QUIT
+28 ;
+29 ;
+30 ;----------
LOTDUP(BILIEN) ;EP
+1 ;---> Return 1 if the Lot# has a duplicate in the IMMUNIZATION LOT
+2 ;---> File; 0 if it is unique.
+3 ;---> Parameters:
+4 ; 1 - BILIEN (req) IEN of Lot# in IMMUNIZATION LOT File.
+5 ;
+6 IF '$GET(BILIEN)
QUIT 0
+7 IF '$DATA(^AUTTIML(BILIEN,0))
QUIT 0
+8 ;
+9 ;---> If Lot# is duplicated in the IMM LOT File, return 1.
+10 NEW Y,Z
SET Y=$PIECE(^AUTTIML(BILIEN,0),U)
SET Z=$ORDER(^AUTTIML("B",Y,0))
+11 IF $ORDER(^AUTTIML("B",Y,Z))
QUIT 1
+12 ;---> Lot# is unique, return 0.
+13 QUIT 0
+14 ;
+15 ;
+16 ;----------
LOTHELP(BILIEN) ;EP
+1 ;---> If chosen Lot# is a duplicate, provide help message.
+2 ;---> Parameters:
+3 ; 1 - BILIEN (req) IEN of Lot# in IMMUNIZATION LOT File.
+4 NEW BIPOP,X
+5 IF '$$LOTDUP(BILIEN)
QUIT
+6 ;
+7 DO TITLE^BIUTL5("DUPLICATE LOT NUMBERS")
+8 SET X="--> Lot# "_$$LOTTX^BIUTL6(BILIEN)_" <--"
DO CENTERT^BIUTL5(.X)
+9 WRITE X,!
+10 Begin DoDot:1
+11 IF $$MAYMANAG^BIUTL11
Begin DoDot:2
+12 DO TEXT2^BIUTL6
DO DIRZ^BIUTL3(.BIPOP)
+13 IF $GET(BIPOP)
QUIT
+14 DO TITLE^BIUTL5("DUPLICATE LOT NUMBERS")
DO TEXT3^BIUTL6
End DoDot:2
QUIT
+15 DO TEXT1^BIUTL6
End DoDot:1
+16 IF '$GET(BIPOP)
DO DIRZ^BIUTL3()
+17 DO REFRESH^DDSUTL
+18 SET BI("D")=""
SET DDSBR=3
DO PUT^DDSVALF(3)
+19 QUIT
+20 ;
+21 ;
+22 ;----------
LOTSCR ;EP
+1 ;---> Set Screen for Lot Number selection in Screen field of
+2 ;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
+3 ;---> when selecting Lot Number.
+4 ;---> Screen: If this Lot Number is Active, AND if no Vaccine has been selected OR
+5 ;---> this Lot Number is assigned to the selected Vaccine,
+6 ;---> AND if EITHER [it has no specific Location] OR
+7 ;---> [its Location matches the user's Location (DUZ(2))].
+8 ;
+9 NEW BILOC
SET BILOC=$PIECE($GET(^AUTTIML(+Y,0)),U,14)
+10 ;
+11 ;---> Next line: Concat to avoid suspected naked ref.
+12 SET DIR("S")="I $P(^"_"(0),U,3)=0,($G(BI(""B""))=""""!$D(^AUTTIML(""C"",+$G(BI(""B"")),Y)))"
+13 SET DIR("S")=DIR("S")_",(('$P($G(^AUTTIML(Y,0)),U,14))!($P($G(^AUTTIML(Y,0)),U,14)=$G(DUZ(2))))"
+14 QUIT
+15 ;
+16 ;
+17 ;----------
LOTSEL(BIX) ;EP
+1 ;---> Action to take after Lot Number has been selected.
+2 ;---> Parameters:
+3 ; 1 - BIX (req) X=Internal Value of Lot Number selected.
+4 ;
+5 ;---> Executed from the "POST ACTION ON CHANGE" field of the
+6 ;---> "Form ONly Field Properties" of the Form BI FORM-IMM VISIT ADD/EDIT.
+7 ;
+8 ;---> Action: If a Vaccine was not chosen, but instead a Lot Number was entered first,
+9 ;---> then populate the Vaccine field on the form (which triggers VACCHG above).
+10 ;
+11 IF 'BIX
QUIT
+12 ;
+13 Begin DoDot:1
+14 ;---> Don't change the Vaccine if it has already been selected.
+15 IF (+$GET(BI("B")))
QUIT
+16 ;---> Stuff Vaccine IEN for this Lot Number.
+17 NEW BIVAC
SET BIVAC=$$LOTTX^BIUTL6(BIX,1)
+18 DO PUT^DDSVALF(2,,,BIVAC,"I")
+19 DO VACSEL(BIVAC)
+20 DO LOTWARN^BIUTL7($GET(BI("D")),$GET(BI("E")),$GET(BI("F")))
+21 DO VISVOL(BIVAC)
End DoDot:1
+22 ;
+23 Begin DoDot:1
+24 ;---> Stuff default NDC IEN for this Lot Number.
+25 IF (+$GET(BI("H")))
QUIT
+26 NEW BINDC
SET BINDC=$$LOTTX^BIUTL6(BIX,3)
+27 IF BINDC
DO PUT^DDSVALF(3.8,,,BINDC,"I")
End DoDot:1
+28 ;
+29 QUIT
+30 ;
+31 ;
+32 ;----------
NDCSCR ;EP
+1 ;---> Set Screen for NDC Code selection in Screen field of
+2 ;---> "Form Only Field Parameters" of the Form BI FORM-IMM VISIT ADD/EDIT
+3 ;---> when selecting NDC Code.
+4 ;---> Screen: If this NDC is Active, AND this NDC is assigned to the selected
+5 ;---> vaccine in BI("B").
+6 ;
+7 ;W !!,"This screen in NDCSCR^BIUTL4",! X ^O
+8 SET DIR("S")="I $P(^BINDC(Y,0),U,6)'=1,$D(^BINDC(""C"",+$G(BI(""B"")),Y))"
+9 QUIT
+10 ;
+11 ;
+12 ;----------
CREASCR ;EP
+1 ;---> Set Screen for Contraindication Reason selection in Reason field
+2 ;---> "Form Only Field Parameters" of the Form BI FORM-CONTRAINDICATION ADD.
+3 ;---> Screen: If this Reason is Active AND if this Reason is Skin Test
+4 ;---> related AND this Vaccine is a Skin Test.
+5 ;
+6 ;---> If no vaccine chosen, then screen says all reasons are invalid.
+7 IF '$GET(BI("B"))
SET DIR("S")="I 0"
QUIT
+8 ;
+9 SET DIR("S")="I ($P(^BICONT(Y,0),U,3))&(+$P(^BICONT(Y,0),U,4)"
+10 SET DIR("S")=DIR("S")_"=+$P(^AUTTIMM(BI(""B""),0),U,8))"
+11 QUIT
+12 ;
+13 ;
+14 ;----------
HISTORY(X) ;EP
+1 ;---> See BIUTL9.
+2 DO HISTORY^BIUTL9(X)
+3 QUIT
+4 ;
+5 ;
+6 ;----------
OLDDATE(X) ;EP
+1 ;---> Add/Edit Screenman actions to take ON POST-CHANGE of Date Field.
+2 ;---> If date entered is earlier than today, Category default changes to
+3 ;---> Historical. If the date is more than 5 days earlier than today,
+4 ;---> user as default Provider is removed.
+5 ;---> Parameters:
+6 ; 1 - X (opt) X=Internal Value of Date of Visit entered.
+7 ;
+8 ;
+9 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+10 ;---> Make VIS Presented Date default to Visit Date (when changed).
+11 NEW BIDATEE
SET BIDATEE=X
+12 ;
+13 IF '$GET(BI("K"))&($PIECE(X,".")'=DT)
Begin DoDot:1
+14 DO PUT^DDSVALF(11,,,"E","I")
SET BI("I")="E"
+15 IF ($GET(DT)-X)>5
DO NOPROV^BIUTL7("E")
+16 ;
+17 ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
+18 ;---> If Date not today, set Injection Site and Volume fields not required.
+19 DO REQ^DDSUTL(4,"","",0)
DO REQ^DDSUTL(5,"","",0)
End DoDot:1
+20 ;
+21 ;
+22 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+23 ;---> Only stuff VIS Presented Date if this is a V Imm.
+24 ;D PUT^DDSVALF(10.2,,,BIDATEE,"E") S BI("QQ")=BIDATEE
+25 IF $GET(BIVTYPE)="I"
DO PUT^DDSVALF(10.2,,,BIDATEE,"E")
SET BI("QQ")=BIDATEE
+26 ;
+27 ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR
+28 ;---> Insert missing Q.
+29 QUIT
+30 ;**********
+31 ;
+32 ;
+33 ;----------
SKINCHG(BISKIEN) ;EP
+1 ;---> Actions to take in Screenman when the Skin Test is selected
+2 ;---> or changed.
+3 ;---> Called by the POST ACTION ON CHANGE of Field 2, Skin Test"
+4 ;---> of the Form BI FORM-SKIN VISIT ADD/EDIT.
+5 ;---> Parameters:
+6 ; 1 - BISKIEN (opt) IEN of Vaccine IMMUNIZATION File (9999999.14).
+7 ; (Not used for now.)
+8 IF '$GET(BISKIEN)
QUIT
+9 ;
+10 ;---> If this is NOT a new visit, inform user that Dose#, Lot#,
+11 ;---> Reaction, and VIS will be deleted and replaced.
+12 IF $GET(BI("K"))
Begin DoDot:1
+13 NEW BIMSG
+14 SET BIMSG="* NOTE: Because you have changed the Skin Test, the Result,"
+15 SET BIMSG=BIMSG_" Reading, Date of Reading, and Reader will be removed."
+16 DO HLP^DDSUTL(BIMSG)
DO HLP^DDSUTL("$$EOP")
End DoDot:1
+17 ;
+18 ;---> Clear data relating to previous Skin Test (if any).
+19 ;Result
DO PUT^DDSVALF(3)
SET BI("L")=""
+20 ;Reading
DO PUT^DDSVALF(4)
SET BI("M")=""
+21 ;Date of Reading
DO PUT^DDSVALF(5)
SET BI("N")=""
+22 ;Reader
DO PUT^DDSVALF(10)
SET BI("X")=""
+23 QUIT
+24 ;
+25 ;
+26 ;----------
SERVAL(BIDOSE,BIVAC) ;EP
+1 ;---> Validate Dose# for this Immunization Visit.
+2 ;---> Parameters:
+3 ; 1 - BIDOSE (req) Dose# entered by the user.
+4 ; 2 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
+5 ;
+6 IF 'BIDOSE
QUIT
IF 'BIVAC
QUIT
+7 SET BIMAX=$$VMAX^BIUTL2(BIVAC)
+8 ;
+9 ;---> If Dose# entered is greater than Max Dose# for this Vaccine,
+10 ;---> reject value and display help text.
+11 IF BIDOSE>BIMAX
SET DDSERROR=1
Begin DoDot:1
+12 NEW Z
+13 SET Z="The Maximum Dose# for "_$$VNAME^BIUTL2(BIVAC)_" is "_BIMAX
+14 SET Z=Z_". Please enter a number between 1 and "_BIMAX_"."
+15 DO HLP^DDSUTL(Z)
End DoDot:1
+16 QUIT
+17 ;
+18 ;
+19 ;----------
INACTV(X) ;EP
+1 ;---> Called by the POST ACTION of Field 4, "Inactive Date"
+2 ;---> of the Form BI FORM-CASE DATA EDIT.
+3 ;---> Actions to take in Screenman when Patient is made Inactive
+4 ;---> by adding a date to Field 4, Inactive Date, of the Form.
+5 ;---> Parameters:
+6 ; 1 - X (req) Internal value of the date entered.
+7 ;
+8 ;---> If no Inactive Date entered, set Reason="" and "Moved to"=""
+9 ;---> and disable navigation to and editing of the fields.
+10 IF '$GET(X)
Begin DoDot:1
+11 DO PUT^DDSVALF(5)
DO PUT^DDSVALF(5.5)
+12 DO UNED^DDSUTL(5,,,1)
DO UNED^DDSUTL(5.5,,,1)
+13 SET (BI("F"),BI("I"))="@"
End DoDot:1
QUIT
+14 ;---> A date has been entered, so enable edit and navigation.
+15 DO UNED^DDSUTL(5,,,0)
DO UNED^DDSUTL(5.5,,,0)
+16 QUIT
+17 ;
+18 ;
+19 ;----------
LOCBR ;EP
+1 ;---> Location Type branching logic for Add/Edit Imm Visit Form:
+2 ;---> "Location" field.
+3 ;
+4 ;---> If Location Type is "Other":
+5 IF (X="O")&($GET(DDSOLD)'="O")
Begin DoDot:1
+6 ;
+7 ;---> Disable IHS Loc (7) and put a null value in IHS Loc (7).
+8 DO UNED^DDSUTL(7,,,1)
DO PUT^DDSVALF(7)
+9 ;
+10 ;---> Set IHS Location IEN in BI array =null (ADD+18^BIVISIT).
+11 SET BI("F")=""
+12 ;
+13 ;---> Enable Other Loc (8).
+14 DO UNED^DDSUTL(8,,,0)
+15 ;
+16 ;---> Make Other Loc required, and IHS Loc not required.
+17 DO REQ^DDSUTL(8,,,1)
DO REQ^DDSUTL(7,,,0)
End DoDot:1
+18 ;
+19 ;
+20 ;---> If Location Type is "IHS":
+21 IF (X="I")&($GET(DDSOLD)'="I")
Begin DoDot:1
+22 ;
+23 ;---> Disable Other Loc (8) and put a null value in Other Loc (8).
+24 DO UNED^DDSUTL(8,,,1)
DO PUT^DDSVALF(8)
+25 ;
+26 ;---> Set Outside Location text in BI array =null (ADD+19^BIVISIT).
+27 SET BI("G")=""
+28 ;
+29 ;---> Enable IHS Loc (7).
+30 DO UNED^DDSUTL(7,,,0)
+31 ;
+32 ;---> Make IHS Loc required, and Other Loc not required.
+33 DO REQ^DDSUTL(7,,,1)
DO REQ^DDSUTL(8,,,0)
DO DEFSITE
End DoDot:1
+34 QUIT
+35 ;
+36 ;
+37 ;----------
VISDATE ;EP
+1 ;---> Enable/disable and if necessary clear VIS Date, based on
+2 ;---> YES/NO answer of VIS Given question.
+3 ;
+4 ;---> If VIS Given=YES (1), then enable editing of VIS Date.
+5 IF X=1
Begin DoDot:1
+6 DO UNED^DDSUTL(13,,,0)
+7 ;---> If no VIS Date present, get default from IMMUNIZATION File.
+8 IF $$GET^DDSVALF(13)
QUIT
+9 NEW BIY
SET BIY=$$GET^DDSVALF(2)
+10 DO PUT^DDSVALF(13,,,$$VISDEF^BIUTL2(BIY))
End DoDot:1
QUIT
+11 ;
+12 ;---> Otherwise, stuff null in VIS Date and make it uneditable.
+13 DO PUT^DDSVALF(13)
SET BI("Q")=""
+14 DO UNED^DDSUTL(13,,,1)
+15 QUIT
+16 ;
+17 ;
+18 ;----------
DEFSITE ;EP
+1 ;---> Code to stuff default Location of Visit in Add/Edit Imm Visit
+2 ;---> form. If Location Type is IHS and current value is null,
+3 ;---> stuff user's DUZ(2) as default.
+4 ;
+5 IF $$GET^DDSVALF(6)'="I"
QUIT
+6 IF $$GET^DDSVALF(7)]""
QUIT
+7 DO PUT^DDSVALF(7,"","",DUZ(2),"I")
+8 QUIT
+9 ;
+10 ;
+11 ;----------
BADREAD ;EP
+1 ;---> Code to check Skin Test results: If the result is Negative,
+2 ;---> the Reading must be <15mm; in that case,
+3 ;---> display help message and reject value.
+4 ;
+5 NEW X
+6 SET X="If the result is NEGATIVE, the Reading must be less than 15 millimeters."
+7 DO HLP^DDSUTL(X)
+8 SET DDSERROR=""
+9 QUIT
+10 ;
+11 ;
+12 ;----------
BADRDAT ;EP
+1 ;---> If the Read Date is earlier than the initial visit date or later
+2 ;---> than today, advise and return to Read Date field.
+3 ;
+4 IF Y<$$GET^DDSVALF(1)
SET DDSERROR=""
Begin DoDot:1
+5 DO HLP^DDSUTL(" * Date of Reading may not be prior to date of initial visit.")
End DoDot:1
QUIT
+6 IF Y>DT
SET DDSERROR=""
Begin DoDot:1
+7 DO HLP^DDSUTL(" * Date of Reading may not be later than today.")
End DoDot:1
QUIT
+8 QUIT
