BIUTL7.m

BIUTL7 ;IHS/CMI/MWR - UTIL: SCREENMAN CODE; MAY 10, 2010

 ;;8.5;IMMUNIZATION;**12**;MAY 01,2016

 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 ;;  SCREENMAN RELATED CODE TO LOAD & SAVE: VISIT, CASE DATA, CONTRAS.

 ;;  PATCH 9: Added Preload of Admin Date and VIS Presented Date. LOADVIS+70

 ;;           Added save of Admin Date and VIS Presented Date. SAVISIT+41

 ;;  PATCH 10: Added Preload of Skin Test Lot Number. LOADVIS+92

 ;;            Added save of Skin Test Lot Number.  SAVISIT+46

 ;;  PATCH 12: Adjust test for External form of date,     LOADVIS+65

 ;;            and Inj Site not req'd if Cat=Historical.

 ;

 ;

 ;----------

LOADVIS(BIVTYPE) ;EP

 ;---> Code to load Visit data for ScreenMan Edit form.

 ;---> Called by Pre Action of Block BI BLK-IMM VISIT ADD/EDIT or

 ;---> BI BLK-SKIN VISIT ADD/EDIT of Forms BI FORM-IMM VISIT ADD/EDIT

 ;---> or BI FORM-SKIN VISIT ADD/EDIT, respectively.

 ;---> Parameters:

 ;     1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.

 ;

 ;---> If BIVTYPE does not="I" (Imm Visit) and it does

 ;---> not="S" (Skin Test Visit), then set Error Code and quit.

 I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D ERRCD^BIUTL2(410,,1) Q

 ;

 ;

 ;---> If this is an old Visit, load data for Screenman.

 D:$G(BI("K"))

 .;

 .;---> IMMUNIZATIONS *

 .D:BIVTYPE="I"

 ..;

 ..;---> Load the Vaccine.

 ..D:$G(BI("B"))

 ...;---> Load Vaccine Name and display Short Name below (if different).

 ...D PUT^DDSVALF(2,,,BI("B"),"I")

 ...D VSHORT(BI("B"))

 ..;

 ..;---> Load Lot Number IEN, and display Lot data (Amount and Exp Date).

 ..I $G(BI("D")) D

 ...D PUT^DDSVALF(3,,,BI("D"),"I")

 ...D LOTDAT(BI("D"))

 ..;

 ..;---> Make Dose Override editable (Screenman Field "Disable Editing"

 ..;---> is set to "YES" by default when the form is loaded.)

 ..D UNED^DDSUTL(14,,,0)

 ..;---> Load Dose Override if there is one.

 ..I $G(BI("S")) D PUT^DDSVALF(14,,,BI("S"),"I")

 ..;

 ..;

 ..;---> Make Reaction editable (Screenman Field "Disable Editing"

 ..;---> is set to "YES" by default when the form is loaded.)

 ..D UNED^DDSUTL(13,,,0)

 ..;---> Load Immunization Reaction.

 ..I $G(BI("O")) D PUT^DDSVALF(13,,,BI("O"),"I")

 ..;

 ..;---> Load the Injection Site.

 ..I $G(BI("T"))]"" D PUT^DDSVALF(4,,,BI("T"),"I")

 ..;

 ..;---> Release/Rev Date of VIS (DD-Mmm-YYYY).

 ..I $G(BI("Q"))>1 D PUT^DDSVALF(10,,,BI("Q"),"E")

 ..;

 ..;---> Load the Volume, add leading zero to Volume if necessary.

 ..I $G(BI("W")) D PUT^DDSVALF(5,,,$$LEADZ^BIUTL5(BI("W")),"E")

 ..;

 ..;---> Load Imported from Outside Source, if=1 (display "edited" if=2).

 ..I $G(BI("Y")) D PUT^DDSVALF(15,,,"*Imported"_$S(BI("Y")=2:" (edited)*",1:"*"))

 ..;

 ..;---> Load VFC Elig if Native and <19.

 ..D VFCSET^BIUTL8

 ..;

 ..;---> Load NDC Code.

 ..I $G(BI("H"))]"" D PUT^DDSVALF(3.8,,,BI("H"),"I")

 ..;

 ..;

 ..;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR

 ..;---> Preload Admin Date and Date VIS Presented.

 ..;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR

 ..;---> Adjust test for External form of date.

 ..;I $G(BI("EE"))>1 D PUT^DDSVALF(1.5,,,BI("EE"),"E")

 ..;I $G(BI("QQ"))>1 D PUT^DDSVALF(10.2,,,BI("QQ"),"E")

 ..I $G(BI("EE"))]"" D PUT^DDSVALF(1.5,,,BI("EE"),"E")

 ..I $G(BI("QQ"))]"" D PUT^DDSVALF(10.2,,,BI("QQ"),"E")

 ..;

 ..;---> If Category is Historical Event, set Inj Site AND Volume NOT Required.

 ..I $G(BI("I"))="E" D REQ^DDSUTL(4,"","",0),REQ^DDSUTL(5,"","",0)

 ..;**********

 .;

 .;---> SKIN TESTS *

 .D:BIVTYPE="S"

 ..;

 ..;---> Load the Skin Test.

 ..D:$G(BI("B")) PUT^DDSVALF(2,,,BI("B"),"I")

 ..;

 ..;---> Load Skin Test Result.

 ..I $G(BI("L"))]"" D PUT^DDSVALF(3,,,$E(BI("L")),"I")

 ..;

 ..;---> Load Skin Test Reading.

 ..I $G(BI("M"))'="" D PUT^DDSVALF(4,,,BI("M"),"I")

 ..;

 ..;---> Load Skin Test Date Read.

 ..I $D(BI("N")) D PUT^DDSVALF(5,,,BI("N"),"E")

 ..;

 ..;---> If Reader already stored previously, load it.

 ..I $G(BI("X")) D PUT^DDSVALF(10,,,BI("X"),"I")

 ..;

 ..;---> Load the Injection Site.

 ..I $G(BI("T"))]"" D PUT^DDSVALF(2.4,,,BI("T"),"I")

 ..;

 ..;---> Load the Volume.

 ..I $G(BI("W"))]"" D PUT^DDSVALF(2.8,,,BI("W"),"I")

 ..;

 ..;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR

 ..;---> Preload Skin Test Lot Number.

 ..I $G(BI("LL"))>1 D PUT^DDSVALF(2.9,,,BI("LL"),"I")

 ..;**********

 .;

 .;

 .;---> If there is text for Other Location:

 .D:$G(BI("G"))]""

 ..;---> Set Location Type to Other.

 ..D PUT^DDSVALF(6,,,"O","I")

 ..;---> Make IHS Loc uneditable and null (ADD+12^BIVISIT will handle).

 ..D UNED^DDSUTL(7,,,1),PUT^DDSVALF(7)

 ..;---> Load Other Loc text and make editable.

 ..D PUT^DDSVALF(8,,,BI("G")),UNED^DDSUTL(8,,,0)

 ..;---> Make Other Loc required, IHS Loc not required.

 ..D REQ^DDSUTL(8,,,1),REQ^DDSUTL(7,,,0)

 .;

 .;---> If Other Loc is null and IHS Loc is set, load it.

 .I $G(BI("G"))="" I $G(BI("F")) D

 ..D PUT^DDSVALF(7,,,BI("F"),"I")

 .;

 .;---> Load Category.

 .I $G(BI("I"))]"" D PUT^DDSVALF(11,,,BI("I"),"I")

 ;

 ;---> Load default date.

 D

 .N X S X=$G(BI("E"))

 .Q:X=""

 .S:X[" @12:00" X=$P(X," @")

 .D PUT^DDSVALF(1,,,X,"E")

 ;

 ;---> Load default site.

 D DEFSITE^BIUTL4

 S BI("F")=$$GET^DDSVALF(7),BI("I")=$$GET^DDSVALF(11)

 ;

 ;---> If this is an Immunization, load VFC Eligibility and Local Text.

 I BIVTYPE="I",$G(BI("P"))]"" D PUT^DDSVALF(10.5,,,BI("P"),"I"),ELIGLAB^BIUTL8(BI("P"))

 ;

 ;---> If Provider already stored previously, load it and quit.

 I $G(BI("R")) D PUT^DDSVALF(9,,,BI("R"),"I") Q

 ;

 ;---> If this is a new Skin Test, load default volume of .1 ml.

 I BIVTYPE="S",'$G(BI("K")) S BI("W")=.1 D PUT^DDSVALF(2.8,,,BI("W"),"I")

 ;

 ;---> If this is a new Visit, and if Site Parameter is yes, and

 ;---> if the User is a provider, then load User as default Provider.

 I '$G(BI("K")),$$DEFPROV^BIUTL6($G(DUZ(2))) D

 .I $D(^XUSEC("PROVIDER",DUZ)) D

 ..;

 ..;---> Same as NOPROV (see below).

 ..Q:('$G(BI("K"))&($G(BI("I"))="E"))

 ..;

 ..;---> To set default provider into local BI array, even if the

 ..;---> user doesn't <return> past the provider field on the screen.

 ..D PUT^DDSVALF(9,,,$G(DUZ),"I") S BI("R")=$G(DUZ)

 ;

 Q

 ;

 ;

 ;----------

NOPROV(X) ;EP

 ;---> Called by Post Action field of Field 11 on BI FORM-IMM VISIT ADD/EDIT

 ;---> and BI FORM-SKIN VISIT ADD/EDIT.

 ;---> If adding a new immunization and user changes Category to

 ;---> "E" (Hist Event), then remove default user/provider from Field 9.

 ;---> Parameters:

 ;     1 - X  Value of Field 11, Category (A, E or I).

 I X="E" I '$G(BI("K")) D PUT^DDSVALF(9,,,"") S BI("R")=""

 Q

 ;

 ;********** PATCH 9 & 12, v8.5, OCT 01,2014 & May 01,2016 IHS/CMI/MWR

 ;---> Next 6 calls moved to BIUTL9 for space (<15000k).

 ;

 ;----------

REASCHK ;EP

 ;---> See BIUTL9.

 D REASCHK^BIUTL9

 Q

 ;

 ;

 ;----------

READCHK ;EP

 ;---> See BIUTL9.

 D READCHK^BIUTL9

 Q

 ;

 ;

 ;----------

READCH6 ;EP

 ;---> See BIUTL9.

 D READCH6^BIUTL9

 Q

 ;

 ;

 ;----------

CREASCHK ;EP

 ;---> See BIUTL9.

 D CREASCHK^BIUTL9

 Q

 ;

 ;

 ;----------

LOTDAT(X) ;EP

 ;---> See BIUTL9.

 D LOTDAT^BIUTL9(X)

 Q

 ;

 ;

 ;----------

VSHORT(X) ;EP

 ;---> See BIUTL9.

 D VSHORT^BIUTL9(X)

 Q

 ;**********

 ;

 ;

 ;----------

LOTWARN(BILIEN,BIVDATE,BILOC) ;EP

 ;---> Called by Branching Logic field of Field 3 on BI FORM-IMM VISIT ADD/EDIT.

 ;---> Display Lot Exp Date and Remaining Balance (if tracked).

 ;---> Parameters:

 ;     1 - BILIEN  (req) IEN of Lot Number in ^AUTTIML.

 ;     2 - BIVDATE (req) Date of Imm Visit.

 ;     3 - BILOC   (req) Location of Encounter.

 ;

 Q:'$G(BILIEN)  Q:'$D(^AUTTIML(BILIEN,0))

 N BIEXP,BILOW S (BIEXP,BILOW)=0

 ;

 D

 .N X S X=$$LOTRBAL^BIRPC3(BILIEN)

 .;---> Do not alert if this Lot is not tracked.   vvv83

 .Q:(X="Not tracked")

 .I X<$$LOTLOW^BIUTL2(BILIEN,BILOC) S BILOW=1

 ;

 D

 .N X S X=$$LOTEXP^BIRPC3(BILIEN,2)

 .;---> Do not warn if this Lot has no expiration date.

 .Q:('X)

 .I BIVDATE>X S BIEXP=1

 ;

 I (BILOW&BIEXP) S DDSSTACK="BI PAGE-EXPIRED AND LOW" Q

 I BILOW S DDSSTACK="BI PAGE-LOW SUPPLY ALERT"

 I BIEXP S DDSSTACK="BI PAGE-LOT EXPIRED"

 Q

 ;

 ;

 ;----------

SAVISIT(BIVTYPE,BI) ;EP

 ;---> Called by BIPATVW2 to save data after exiting Screenman Forms

 ;---> BI FORM-IMM VISIT ADD/EDIT and BI FORM-SKIN VISIT ADD/EDIT.

 ;---> Parameters:

 ;     1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.

 ;     2 - BI      (req) Local array of data elements for this visit.

 ;

 N BI31 S BI31=$C(31)_$C(31)

 ;

 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does

 ;---> not="S" (Skin Test Visit), then set Error Code and quit.

 I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D ERRCD^BIUTL2(410,,1) Q

 ;

 N A,B,BIDATA,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z,EE,QQ,LL S V="|"

 ;

 S A=$G(BI("A"))      ;Patient DFN.

 S B=$G(BI("B"))      ;Vaccine or Skin Test IEN.

 S C=$G(BI("C"))      ;Dose Override.

 S D=$G(BI("D"))      ;Lot Number IEN.

 S E=$G(BI("E"))      ;Date of Visit.

 S F=$G(BI("F"))      ;Location of Encounter IEN.

 S G=$G(BI("G"))      ;Other Location of Encounter Text.

 S H=$G(BI("H"))      ;NDC Code Pointer.

 S I=$G(BI("I"))      ;Catgegory of Visit (A,E,I).

 S J=$G(BI("J"))      ;Visit IEN

 S K=$G(BI("K"))      ;Old Visit IEN (for edits).

 S L=$G(BI("L"))      ;Skin Test Result.

 S M=$G(BI("M"))      ;Skin Test Reading (mm).

 S N=$G(BI("N"))      ;Skin Test Date Read.

 S O=$G(BI("O"))      ;Immunization Reaction

 S P=$G(BI("P"))      ;VFC Elilgibility

 S Q=$G(BI("Q"))      ;Release/Revision Date of VIS (DD-Mmm-YYYY).

 S R=$G(BI("R"))      ;IEN of Provider of Imm/Skin Test.

 S S=$G(BI("S"))      ;Dose Override.

 S T=$G(BI("T"))      ;Injection Site.

 S W=$G(BI("W"))      ;Volume.

 S X=$G(BI("X"))      ;IEN of Reader (Provider) of Skin Test.

 S Z=$G(BI("Z"))      ;DUZ(2) for Site Parameters.

 S Y=$G(BI("Y"))      ;If Y=1, this was a previously imported Imm;

 ;                     now it needs to =2 ("Imported (edited)").

 ;

 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR

 ;---> Add Admin Date and VIS Presented Date to data being saved.

 S EE=$G(BI("EE"))     ;Admin Date (Date shot admin'd to patient.

 S QQ=$G(BI("QQ"))     ;Date VIS Presented to Patient.

 ;

 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR

 ;---> Add Skin Test Lot Number.

 S LL=$G(BI("LL"))

 ;

 ;---> Check Site IEN for parameters.

 S:'$G(Z) Z=$G(DUZ(2))

 I '$G(Z) D ERRCD^BIUTL2(105,,1) Q

 ;---> Piece:       2   3   4   5   6   7   8   9   10  11

 S BIDATA=BIVTYPE_V_A_V_B_V_C_V_D_V_E_V_F_V_G_V_I_V_J_V_K

 ;---> NOTE: Y will be pc 25 (not 24) because BIRPC6 feeds CPT Import to pc 24.

 ;---> Add pieces 27-29.

 ;---> Add piece 30.

 ;---> Piece:     12  13  14  15  16  17  18  19  20  21  22  23 24 25  26 27  28   29   30

 S BIDATA=BIDATA_V_L_V_M_V_N_V_O_V_P_V_Q_V_R_V_S_V_T_V_W_V_X_V_Z_V_V_Y_V_H_V_V_EE_V_QQ_V_LL

 ;

 ;**********

 ;

 ;---> Call RPC to save visit to PCC Files.

 D ADDEDIT^BIRPC3(.BIERR,BIDATA)

 ;

 ;---> If an error is passed back, display it.

 S BIERR=$P(BIERR,BI31,2)

 D:BIERR]""

 .W !!," * ",BIERR,!?3,"NO Changes made! (Visit NOT added/edited.)"

 .D DIRZ^BIUTL3()

 ;

 Q

 ;

 ;

 ;----------

SAVCONTR(BI,BIERR) ;EP

 ;---> Called by BIPATCO2 to save data after exiting Screenman Form

 ;---> BI FORM-CONTRAINDICATION ADD/EDIT.

 ;---> Parameters:

 ;     1 - BI    (req) Local array of data elements for this contra.

 ;     1 - BIERR (ret) Text of Error Code if any, otherwise null.

 ;

 N BI31 S BI31=$C(31)_$C(31)

 N A,B,C,D,N,V S V="|"

 ;

 S A=$G(BI("A"))      ;Patient DFN.

 S B=$G(BI("B"))      ;Vaccine IEN (^AUTTIMM).

 S C=$G(BI("C"))      ;Contra Reason IEN (^BICONT).

 S D=$G(BI("D"))      ;Date Noted.

 S N=$G(BI("N"))      ;If this was an Edit, N=1 (otherwise null/0).

 ;

 D ADDCONT^BIRPC4(.BIERR,A_V_B_V_C_V_D_V_N)

 ;

 ;---> If an error is passed back, display it.

 S BIERR=$P(BIERR,BI31,2)

 D:BIERR]""

 .W !!," * ",BIERR,!?3,"Contraindication NOT added!" D DIRZ^BIUTL3()

 ;

 Q

 ;

 ;

 ;----------

LDCONTR ;EP

 ;---> Code to load Contraindication data for ScreenMan Edit form.

 ;---> Called by Pre Action of Block BI BLK-CONTRAINDICATION ADD

 ;---> of Form BI FORM-CONTRAIND ADD/EDIT

 ;

 ;

 Q:'$G(BIDFN)

 Q:'$G(BI("N"))

 ;

 ;---> Load Vaccine Name.

 I $G(BI("B"))]"" D PUT^DDSVALF(1,,,BI("B"),"I")

 ;

 ;---> Make Vaccine Name uneditable.

 D UNED^DDSUTL(1,,,1)

 ;

 ;---> Load Reaspm.

 I $G(BI("C"))]"" D PUT^DDSVALF(4,,,BI("C"),"E")

 ;

 ;---> Load Date.

 I $G(BI("D"))]"" D PUT^DDSVALF(5,,,BI("D"),"E")

 ;

 Q

 ;

 ;

 ;----------

LOADCAS ;EP

 ;---> Code to load Case Data for a patient for ScreenMan Edit form.

 ;---> Called by Pre Action of Block BI BLK-CASE DATE EDIT on

 ;---> Form BI FORM-CASE DATA EDIT.

 ;

 Q:'$G(BIDFN)

 ;

 ;---> Load Patient's Case Manager or default Case Manager.

 D

 .I $G(BI("B"))]"" D PUT^DDSVALF(1,,,BI("B"),"E") Q

 .Q:'$G(DUZ(2))

 .N BIX S BIX=$$CMGRDEF^BIUTL2(DUZ(2))

 .D:BIX PUT^DDSVALF(1,,,BIX,"I")

 ;

 ;---> Load Parent/Guardian.

 I $G(BI("C"))]"" D PUT^DDSVALF(2,,,BI("C"),"E")

 ;

 ;---> Load Mother's HBsAG Status.

 I $G(BI("D"))]"" D PUT^DDSVALF(7,,,BI("D"),"I")

 ;

 ;---> Load Date Patient became Inactive.

 I $G(BI("E"))]"" D PUT^DDSVALF(4,,,BI("E"),"E")

 ;

 ;---> Load Reason for Inactive.

 I $G(BI("F"))]"" D PUT^DDSVALF(5,,,BI("F"),"I")

 ;

 ;---> Load Other Info.

 I $G(BI("G"))]"" D PUT^DDSVALF(3,,,BI("G"),"E")

 ;

 ;---> Load Forecast Influ/Pneumo.

 I $G(BI("H"))]"" D PUT^DDSVALF(6,,,BI("H"),"I")

 ;

 ;---> Load Moved to/Tx Elsewhere.

 I $G(BI("I"))]"" D PUT^DDSVALF(5.5,,,BI("I"),"E")

 ;

 ;---> Load Consent State Registry.

 I $G(BI("K"))]"" D PUT^DDSVALF(8,,,BI("K"),"E")

 Q

 ;

 ;

 ;----------

SAVCAS ;EP

 ;---> Code to save Case Data exiting from Screenman.

 ;---> Called by Post Save Action of Form BI FORM-CASE DATA EDIT.

 ;

 N BI31 S BI31=$C(31)_$C(31)

 N A,B,C,D,DATA,E,F,G,H,I,J,K,U S U="^"

 ;

 S A=$G(BI("A"))      ;Patient DFN.

 S B=$G(BI("B"))      ;Case Manager's name, text.

 S C=$G(BI("C"))      ;Parent or Guardian, text.

 S D=$G(BI("D"))      ;Mother's HBsAG Status (P,N,A,U).

 S E=$G(BI("E"))      ;Date Pat became Inactive (ext format).

 S F=$G(BI("F"))      ;Reason for Inactive.

 S G=$G(BI("G"))      ;Other Info.

 S H=$G(BI("H"))      ;Forecast Influ/Pneumo.

 S I=$G(BI("I"))      ;Location Moved or Tx Elsewhere.

 S K=$G(BI("K"))      ;State Registry Consent.

 ;

 I E]"" S J=$G(DUZ)   ;IEN of User who Inactivated this patient.

 ;

 S DATA=A_U_B_U_C_U_D_U_E_U_F_U_G_U_H_U_I_U_$G(J)_U_K

 ;

 ;---> Store edits to database.

 D EDITCAS^BIRPC4(.BIERR,DATA)

 ;

 ;---> If an error is passed back, display it.

 S BIERR=$P(BIERR,BI31,2)

 D:BIERR]""

 .W !!," * ",BIERR,!?3,"Edits to Patient Case Data not saved!"

 .D DIRZ^BIUTL3()

 ;

 Q

BIUTL7    ;IHS/CMI/MWR - UTIL: SCREENMAN CODE; MAY 10, 2010

 +1       ;;8.5;IMMUNIZATION;**12**;MAY 01,2016

 +2       ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *

 +3       ;;  SCREENMAN RELATED CODE TO LOAD & SAVE: VISIT, CASE DATA, CONTRAS.

 +4       ;;  PATCH 9: Added Preload of Admin Date and VIS Presented Date. LOADVIS+70

 +5       ;;           Added save of Admin Date and VIS Presented Date. SAVISIT+41

 +6       ;;  PATCH 10: Added Preload of Skin Test Lot Number. LOADVIS+92

 +7       ;;            Added save of Skin Test Lot Number.  SAVISIT+46

 +8       ;;  PATCH 12: Adjust test for External form of date,     LOADVIS+65

 +9       ;;            and Inj Site not req'd if Cat=Historical.

 +10      ;

 +11      ;

 +12      ;----------

LOADVIS(BIVTYPE) ;EP

 +1       ;---> Code to load Visit data for ScreenMan Edit form.

 +2       ;---> Called by Pre Action of Block BI BLK-IMM VISIT ADD/EDIT or

 +3       ;---> BI BLK-SKIN VISIT ADD/EDIT of Forms BI FORM-IMM VISIT ADD/EDIT

 +4       ;---> or BI FORM-SKIN VISIT ADD/EDIT, respectively.

 +5       ;---> Parameters:

 +6       ;     1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.

 +7       ;

 +8       ;---> If BIVTYPE does not="I" (Imm Visit) and it does

 +9       ;---> not="S" (Skin Test Visit), then set Error Code and quit.

 +10       IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")

               DO ERRCD^BIUTL2(410,,1)

               QUIT 

 +11      ;

 +12      ;

 +13      ;---> If this is an old Visit, load data for Screenman.

 +14       IF $GET(BI("K"))

               Begin DoDot:1

 +15      ;

 +16      ;---> IMMUNIZATIONS *

 +17               IF BIVTYPE="I"

                       Begin DoDot:2

 +18      ;

 +19      ;---> Load the Vaccine.

 +20                       IF $GET(BI("B"))

                               Begin DoDot:3

 +21      ;---> Load Vaccine Name and display Short Name below (if different).

 +22                               DO PUT^DDSVALF(2,,,BI("B"),"I")

 +23                               DO VSHORT(BI("B"))

                               End DoDot:3

 +24      ;

 +25      ;---> Load Lot Number IEN, and display Lot data (Amount and Exp Date).

 +26                       IF $GET(BI("D"))

                               Begin DoDot:3

 +27                               DO PUT^DDSVALF(3,,,BI("D"),"I")

 +28                               DO LOTDAT(BI("D"))

                               End DoDot:3

 +29      ;

 +30      ;---> Make Dose Override editable (Screenman Field "Disable Editing"

 +31      ;---> is set to "YES" by default when the form is loaded.)

 +32                       DO UNED^DDSUTL(14,,,0)

 +33      ;---> Load Dose Override if there is one.

 +34                       IF $GET(BI("S"))

                               DO PUT^DDSVALF(14,,,BI("S"),"I")

 +35      ;

 +36      ;

 +37      ;---> Make Reaction editable (Screenman Field "Disable Editing"

 +38      ;---> is set to "YES" by default when the form is loaded.)

 +39                       DO UNED^DDSUTL(13,,,0)

 +40      ;---> Load Immunization Reaction.

 +41                       IF $GET(BI("O"))

                               DO PUT^DDSVALF(13,,,BI("O"),"I")

 +42      ;

 +43      ;---> Load the Injection Site.

 +44                       IF $GET(BI("T"))]""

                               DO PUT^DDSVALF(4,,,BI("T"),"I")

 +45      ;

 +46      ;---> Release/Rev Date of VIS (DD-Mmm-YYYY).

 +47                       IF $GET(BI("Q"))>1

                               DO PUT^DDSVALF(10,,,BI("Q"),"E")

 +48      ;

 +49      ;---> Load the Volume, add leading zero to Volume if necessary.

 +50                       IF $GET(BI("W"))

                               DO PUT^DDSVALF(5,,,$$LEADZ^BIUTL5(BI("W")),"E")

 +51      ;

 +52      ;---> Load Imported from Outside Source, if=1 (display "edited" if=2).

 +53                       IF $GET(BI("Y"))

                               DO PUT^DDSVALF(15,,,"*Imported"_$SELECT(BI("Y")=2:" (edited)*",1:"*"))

 +54      ;

 +55      ;---> Load VFC Elig if Native and <19.

 +56                       DO VFCSET^BIUTL8

 +57      ;

 +58      ;---> Load NDC Code.

 +59                       IF $GET(BI("H"))]""

                               DO PUT^DDSVALF(3.8,,,BI("H"),"I")

 +60      ;

 +61      ;

 +62      ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR

 +63      ;---> Preload Admin Date and Date VIS Presented.

 +64      ;********** PATCH 12, v8.5, MAY 01,2016, IHS/CMI/MWR

 +65      ;---> Adjust test for External form of date.

 +66      ;I $G(BI("EE"))>1 D PUT^DDSVALF(1.5,,,BI("EE"),"E")

 +67      ;I $G(BI("QQ"))>1 D PUT^DDSVALF(10.2,,,BI("QQ"),"E")

 +68                       IF $GET(BI("EE"))]""

                               DO PUT^DDSVALF(1.5,,,BI("EE"),"E")

 +69                       IF $GET(BI("QQ"))]""

                               DO PUT^DDSVALF(10.2,,,BI("QQ"),"E")

 +70      ;

 +71      ;---> If Category is Historical Event, set Inj Site AND Volume NOT Required.

 +72                       IF $GET(BI("I"))="E"

                               DO REQ^DDSUTL(4,"","",0)

                               DO REQ^DDSUTL(5,"","",0)

 +73      ;**********

                       End DoDot:2

 +74      ;

 +75      ;---> SKIN TESTS *

 +76               IF BIVTYPE="S"

                       Begin DoDot:2

 +77      ;

 +78      ;---> Load the Skin Test.

 +79                       IF $GET(BI("B"))

                               DO PUT^DDSVALF(2,,,BI("B"),"I")

 +80      ;

 +81      ;---> Load Skin Test Result.

 +82                       IF $GET(BI("L"))]""

                               DO PUT^DDSVALF(3,,,$EXTRACT(BI("L")),"I")

 +83      ;

 +84      ;---> Load Skin Test Reading.

 +85                       IF $GET(BI("M"))'=""

                               DO PUT^DDSVALF(4,,,BI("M"),"I")

 +86      ;

 +87      ;---> Load Skin Test Date Read.

 +88                       IF $DATA(BI("N"))

                               DO PUT^DDSVALF(5,,,BI("N"),"E")

 +89      ;

 +90      ;---> If Reader already stored previously, load it.

 +91                       IF $GET(BI("X"))

                               DO PUT^DDSVALF(10,,,BI("X"),"I")

 +92      ;

 +93      ;---> Load the Injection Site.

 +94                       IF $GET(BI("T"))]""

                               DO PUT^DDSVALF(2.4,,,BI("T"),"I")

 +95      ;

 +96      ;---> Load the Volume.

 +97                       IF $GET(BI("W"))]""

                               DO PUT^DDSVALF(2.8,,,BI("W"),"I")

 +98      ;

 +99      ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR

 +100     ;---> Preload Skin Test Lot Number.

 +101                      IF $GET(BI("LL"))>1

                               DO PUT^DDSVALF(2.9,,,BI("LL"),"I")

 +102     ;**********

                       End DoDot:2

 +103     ;

 +104     ;

 +105     ;---> If there is text for Other Location:

 +106              IF $GET(BI("G"))]""

                       Begin DoDot:2

 +107     ;---> Set Location Type to Other.

 +108                      DO PUT^DDSVALF(6,,,"O","I")

 +109     ;---> Make IHS Loc uneditable and null (ADD+12^BIVISIT will handle).

 +110                      DO UNED^DDSUTL(7,,,1)

                           DO PUT^DDSVALF(7)

 +111     ;---> Load Other Loc text and make editable.

 +112                      DO PUT^DDSVALF(8,,,BI("G"))

                           DO UNED^DDSUTL(8,,,0)

 +113     ;---> Make Other Loc required, IHS Loc not required.

 +114                      DO REQ^DDSUTL(8,,,1)

                           DO REQ^DDSUTL(7,,,0)

                       End DoDot:2

 +115     ;

 +116     ;---> If Other Loc is null and IHS Loc is set, load it.

 +117              IF $GET(BI("G"))=""

                       IF $GET(BI("F"))

                           Begin DoDot:2

 +118                          DO PUT^DDSVALF(7,,,BI("F"),"I")

                           End DoDot:2

 +119     ;

 +120     ;---> Load Category.

 +121              IF $GET(BI("I"))]""

                       DO PUT^DDSVALF(11,,,BI("I"),"I")

               End DoDot:1

 +122     ;

 +123     ;---> Load default date.

 +124      Begin DoDot:1

 +125          NEW X

               SET X=$GET(BI("E"))

 +126          IF X=""

                   QUIT 

 +127          IF X[" @12

                   SET X=$PIECE(X," @")

 +128          DO PUT^DDSVALF(1,,,X,"E")

           End DoDot:1

 +129     ;

 +130     ;---> Load default site.

 +131      DO DEFSITE^BIUTL4

 +132      SET BI("F")=$$GET^DDSVALF(7)

           SET BI("I")=$$GET^DDSVALF(11)

 +133     ;

 +134     ;---> If this is an Immunization, load VFC Eligibility and Local Text.

 +135      IF BIVTYPE="I"

               IF $GET(BI("P"))]""

                   DO PUT^DDSVALF(10.5,,,BI("P"),"I")

                   DO ELIGLAB^BIUTL8(BI("P"))

 +136     ;

 +137     ;---> If Provider already stored previously, load it and quit.

 +138      IF $GET(BI("R"))

               DO PUT^DDSVALF(9,,,BI("R"),"I")

               QUIT 

 +139     ;

 +140     ;---> If this is a new Skin Test, load default volume of .1 ml.

 +141      IF BIVTYPE="S"

               IF '$GET(BI("K"))

                   SET BI("W")=.1

                   DO PUT^DDSVALF(2.8,,,BI("W"),"I")

 +142     ;

 +143     ;---> If this is a new Visit, and if Site Parameter is yes, and

 +144     ;---> if the User is a provider, then load User as default Provider.

 +145      IF '$GET(BI("K"))

               IF $$DEFPROV^BIUTL6($GET(DUZ(2)))

                   Begin DoDot:1

 +146                  IF $DATA(^XUSEC("PROVIDER",DUZ))

                           Begin DoDot:2

 +147     ;

 +148     ;---> Same as NOPROV (see below).

 +149                          IF ('$GET(BI("K"))&($GET(BI("I"))="E"))

                                   QUIT 

 +150     ;

 +151     ;---> To set default provider into local BI array, even if the

 +152     ;---> user doesn't <return> past the provider field on the screen.

 +153                          DO PUT^DDSVALF(9,,,$GET(DUZ),"I")

                               SET BI("R")=$GET(DUZ)

                           End DoDot:2

                   End DoDot:1

 +154     ;

 +155      QUIT 

 +156     ;

 +157     ;

 +158     ;----------

NOPROV(X) ;EP

 +1       ;---> Called by Post Action field of Field 11 on BI FORM-IMM VISIT ADD/EDIT

 +2       ;---> and BI FORM-SKIN VISIT ADD/EDIT.

 +3       ;---> If adding a new immunization and user changes Category to

 +4       ;---> "E" (Hist Event), then remove default user/provider from Field 9.

 +5       ;---> Parameters:

 +6       ;     1 - X  Value of Field 11, Category (A, E or I).

 +7        IF X="E"

               IF '$GET(BI("K"))

                   DO PUT^DDSVALF(9,,,"")

                   SET BI("R")=""

 +8        QUIT 

 +9       ;

 +10      ;********** PATCH 9 & 12, v8.5, OCT 01,2014 & May 01,2016 IHS/CMI/MWR

 +11      ;---> Next 6 calls moved to BIUTL9 for space (<15000k).

 +12      ;

 +13      ;----------

REASCHK   ;EP

 +1       ;---> See BIUTL9.

 +2        DO REASCHK^BIUTL9

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;----------

READCHK   ;EP

 +1       ;---> See BIUTL9.

 +2        DO READCHK^BIUTL9

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;----------

READCH6   ;EP

 +1       ;---> See BIUTL9.

 +2        DO READCH6^BIUTL9

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;----------

CREASCHK  ;EP

 +1       ;---> See BIUTL9.

 +2        DO CREASCHK^BIUTL9

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;----------

LOTDAT(X) ;EP

 +1       ;---> See BIUTL9.

 +2        DO LOTDAT^BIUTL9(X)

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;----------

VSHORT(X) ;EP

 +1       ;---> See BIUTL9.

 +2        DO VSHORT^BIUTL9(X)

 +3        QUIT 

 +4       ;**********

 +5       ;

 +6       ;

 +7       ;----------

LOTWARN(BILIEN,BIVDATE,BILOC) ;EP

 +1       ;---> Called by Branching Logic field of Field 3 on BI FORM-IMM VISIT ADD/EDIT.

 +2       ;---> Display Lot Exp Date and Remaining Balance (if tracked).

 +3       ;---> Parameters:

 +4       ;     1 - BILIEN  (req) IEN of Lot Number in ^AUTTIML.

 +5       ;     2 - BIVDATE (req) Date of Imm Visit.

 +6       ;     3 - BILOC   (req) Location of Encounter.

 +7       ;

 +8        IF '$GET(BILIEN)

               QUIT 

           IF '$DATA(^AUTTIML(BILIEN,0))

               QUIT 

 +9        NEW BIEXP,BILOW

           SET (BIEXP,BILOW)=0

 +10      ;

 +11       Begin DoDot:1

 +12           NEW X

               SET X=$$LOTRBAL^BIRPC3(BILIEN)

 +13      ;---> Do not alert if this Lot is not tracked.   vvv83

 +14           IF (X="Not tracked")

                   QUIT 

 +15           IF X<$$LOTLOW^BIUTL2(BILIEN,BILOC)

                   SET BILOW=1

           End DoDot:1

 +16      ;

 +17       Begin DoDot:1

 +18           NEW X

               SET X=$$LOTEXP^BIRPC3(BILIEN,2)

 +19      ;---> Do not warn if this Lot has no expiration date.

 +20           IF ('X)

                   QUIT 

 +21           IF BIVDATE>X

                   SET BIEXP=1

           End DoDot:1

 +22      ;

 +23       IF (BILOW&BIEXP)

               SET DDSSTACK="BI PAGE-EXPIRED AND LOW"

               QUIT 

 +24       IF BILOW

               SET DDSSTACK="BI PAGE-LOW SUPPLY ALERT"

 +25       IF BIEXP

               SET DDSSTACK="BI PAGE-LOT EXPIRED"

 +26       QUIT 

 +27      ;

 +28      ;

 +29      ;----------