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 ;----------
SAVISIT(BIVTYPE,BI) ;EP
+1 ;---> Called by BIPATVW2 to save data after exiting Screenman Forms
+2 ;---> BI FORM-IMM VISIT ADD/EDIT and BI FORM-SKIN VISIT ADD/EDIT.
+3 ;---> Parameters:
+4 ; 1 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+5 ; 2 - BI (req) Local array of data elements for this visit.
+6 ;
+7 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
+8 ;
+9 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+10 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+11 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
DO ERRCD^BIUTL2(410,,1)
QUIT
+12 ;
+13 NEW 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
SET V="|"
+14 ;
+15 ;Patient DFN.
SET A=$GET(BI("A"))
+16 ;Vaccine or Skin Test IEN.
SET B=$GET(BI("B"))
+17 ;Dose Override.
SET C=$GET(BI("C"))
+18 ;Lot Number IEN.
SET D=$GET(BI("D"))
+19 ;Date of Visit.
SET E=$GET(BI("E"))
+20 ;Location of Encounter IEN.
SET F=$GET(BI("F"))
+21 ;Other Location of Encounter Text.
SET G=$GET(BI("G"))
+22 ;NDC Code Pointer.
SET H=$GET(BI("H"))
+23 ;Catgegory of Visit (A,E,I).
SET I=$GET(BI("I"))
+24 ;Visit IEN
SET J=$GET(BI("J"))
+25 ;Old Visit IEN (for edits).
SET K=$GET(BI("K"))
+26 ;Skin Test Result.
SET L=$GET(BI("L"))
+27 ;Skin Test Reading (mm).
SET M=$GET(BI("M"))
+28 ;Skin Test Date Read.
SET N=$GET(BI("N"))
+29 ;Immunization Reaction
SET O=$GET(BI("O"))
+30 ;VFC Elilgibility
SET P=$GET(BI("P"))
+31 ;Release/Revision Date of VIS (DD-Mmm-YYYY).
SET Q=$GET(BI("Q"))
+32 ;IEN of Provider of Imm/Skin Test.
SET R=$GET(BI("R"))
+33 ;Dose Override.
SET S=$GET(BI("S"))
+34 ;Injection Site.
SET T=$GET(BI("T"))
+35 ;Volume.
SET W=$GET(BI("W"))
+36 ;IEN of Reader (Provider) of Skin Test.
SET X=$GET(BI("X"))
+37 ;DUZ(2) for Site Parameters.
SET Z=$GET(BI("Z"))
+38 ;If Y=1, this was a previously imported Imm;
SET Y=$GET(BI("Y"))
+39 ; now it needs to =2 ("Imported (edited)").
+40 ;
+41 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+42 ;---> Add Admin Date and VIS Presented Date to data being saved.
+43 ;Admin Date (Date shot admin'd to patient.
SET EE=$GET(BI("EE"))
+44 ;Date VIS Presented to Patient.
SET QQ=$GET(BI("QQ"))
+45 ;
+46 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+47 ;---> Add Skin Test Lot Number.
+48 SET LL=$GET(BI("LL"))
+49 ;
+50 ;---> Check Site IEN for parameters.
+51 IF '$GET(Z)
SET Z=$GET(DUZ(2))
+52 IF '$GET(Z)
DO ERRCD^BIUTL2(105,,1)
QUIT
+53 ;---> Piece: 2 3 4 5 6 7 8 9 10 11
+54 SET BIDATA=BIVTYPE_V_A_V_B_V_C_V_D_V_E_V_F_V_G_V_I_V_J_V_K
+55 ;---> NOTE: Y will be pc 25 (not 24) because BIRPC6 feeds CPT Import to pc 24.
+56 ;---> Add pieces 27-29.
+57 ;---> Add piece 30.
+58 ;---> Piece: 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
+59 SET 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
+60 ;
+61 ;**********
+62 ;
+63 ;---> Call RPC to save visit to PCC Files.
+64 DO ADDEDIT^BIRPC3(.BIERR,BIDATA)
+65 ;
+66 ;---> If an error is passed back, display it.
+67 SET BIERR=$PIECE(BIERR,BI31,2)
+68 IF BIERR]""
Begin DoDot:1
+69 WRITE !!," * ",BIERR,!?3,"NO Changes made! (Visit NOT added/edited.)"
+70 DO DIRZ^BIUTL3()
End DoDot:1
+71 ;
+72 QUIT
+73 ;
+74 ;
+75 ;----------
SAVCONTR(BI,BIERR) ;EP
+1 ;---> Called by BIPATCO2 to save data after exiting Screenman Form
+2 ;---> BI FORM-CONTRAINDICATION ADD/EDIT.
+3 ;---> Parameters:
+4 ; 1 - BI (req) Local array of data elements for this contra.
+5 ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
+6 ;
+7 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
+8 NEW A,B,C,D,N,V
SET V="|"
+9 ;
+10 ;Patient DFN.
SET A=$GET(BI("A"))
+11 ;Vaccine IEN (^AUTTIMM).
SET B=$GET(BI("B"))
+12 ;Contra Reason IEN (^BICONT).
SET C=$GET(BI("C"))
+13 ;Date Noted.
SET D=$GET(BI("D"))
+14 ;If this was an Edit, N=1 (otherwise null/0).
SET N=$GET(BI("N"))
+15 ;
+16 DO ADDCONT^BIRPC4(.BIERR,A_V_B_V_C_V_D_V_N)
+17 ;
+18 ;---> If an error is passed back, display it.
+19 SET BIERR=$PIECE(BIERR,BI31,2)
+20 IF BIERR]""
Begin DoDot:1
+21 WRITE !!," * ",BIERR,!?3,"Contraindication NOT added!"
DO DIRZ^BIUTL3()
End DoDot:1
+22 ;
+23 QUIT
+24 ;
+25 ;
+26 ;----------
LDCONTR ;EP
+1 ;---> Code to load Contraindication data for ScreenMan Edit form.
+2 ;---> Called by Pre Action of Block BI BLK-CONTRAINDICATION ADD
+3 ;---> of Form BI FORM-CONTRAIND ADD/EDIT
+4 ;
+5 ;
+6 IF '$GET(BIDFN)
QUIT
+7 IF '$GET(BI("N"))
QUIT
+8 ;
+9 ;---> Load Vaccine Name.
+10 IF $GET(BI("B"))]""
DO PUT^DDSVALF(1,,,BI("B"),"I")
+11 ;
+12 ;---> Make Vaccine Name uneditable.
+13 DO UNED^DDSUTL(1,,,1)
+14 ;
+15 ;---> Load Reaspm.
+16 IF $GET(BI("C"))]""
DO PUT^DDSVALF(4,,,BI("C"),"E")
+17 ;
+18 ;---> Load Date.
+19 IF $GET(BI("D"))]""
DO PUT^DDSVALF(5,,,BI("D"),"E")
+20 ;
+21 QUIT
+22 ;
+23 ;
+24 ;----------
LOADCAS ;EP
+1 ;---> Code to load Case Data for a patient for ScreenMan Edit form.
+2 ;---> Called by Pre Action of Block BI BLK-CASE DATE EDIT on
+3 ;---> Form BI FORM-CASE DATA EDIT.
+4 ;
+5 IF '$GET(BIDFN)
QUIT
+6 ;
+7 ;---> Load Patient's Case Manager or default Case Manager.
+8 Begin DoDot:1
+9 IF $GET(BI("B"))]""
DO PUT^DDSVALF(1,,,BI("B"),"E")
QUIT
+10 IF '$GET(DUZ(2))
QUIT
+11 NEW BIX
SET BIX=$$CMGRDEF^BIUTL2(DUZ(2))
+12 IF BIX
DO PUT^DDSVALF(1,,,BIX,"I")
End DoDot:1
+13 ;
+14 ;---> Load Parent/Guardian.
+15 IF $GET(BI("C"))]""
DO PUT^DDSVALF(2,,,BI("C"),"E")
+16 ;
+17 ;---> Load Mother's HBsAG Status.
+18 IF $GET(BI("D"))]""
DO PUT^DDSVALF(7,,,BI("D"),"I")
+19 ;
+20 ;---> Load Date Patient became Inactive.
+21 IF $GET(BI("E"))]""
DO PUT^DDSVALF(4,,,BI("E"),"E")
+22 ;
+23 ;---> Load Reason for Inactive.
+24 IF $GET(BI("F"))]""
DO PUT^DDSVALF(5,,,BI("F"),"I")
+25 ;
+26 ;---> Load Other Info.
+27 IF $GET(BI("G"))]""
DO PUT^DDSVALF(3,,,BI("G"),"E")
+28 ;
+29 ;---> Load Forecast Influ/Pneumo.
+30 IF $GET(BI("H"))]""
DO PUT^DDSVALF(6,,,BI("H"),"I")
+31 ;
+32 ;---> Load Moved to/Tx Elsewhere.
+33 IF $GET(BI("I"))]""
DO PUT^DDSVALF(5.5,,,BI("I"),"E")
+34 ;
+35 ;---> Load Consent State Registry.
+36 IF $GET(BI("K"))]""
DO PUT^DDSVALF(8,,,BI("K"),"E")
+37 QUIT
+38 ;
+39 ;
+40 ;----------
SAVCAS ;EP
+1 ;---> Code to save Case Data exiting from Screenman.
+2 ;---> Called by Post Save Action of Form BI FORM-CASE DATA EDIT.
+3 ;
+4 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
+5 NEW A,B,C,D,DATA,E,F,G,H,I,J,K,U
SET U="^"
+6 ;
+7 ;Patient DFN.
SET A=$GET(BI("A"))
+8 ;Case Manager's name, text.
SET B=$GET(BI("B"))
+9 ;Parent or Guardian, text.
SET C=$GET(BI("C"))
+10 ;Mother's HBsAG Status (P,N,A,U).
SET D=$GET(BI("D"))
+11 ;Date Pat became Inactive (ext format).
SET E=$GET(BI("E"))
+12 ;Reason for Inactive.
SET F=$GET(BI("F"))
+13 ;Other Info.
SET G=$GET(BI("G"))
+14 ;Forecast Influ/Pneumo.
SET H=$GET(BI("H"))
+15 ;Location Moved or Tx Elsewhere.
SET I=$GET(BI("I"))
+16 ;State Registry Consent.
SET K=$GET(BI("K"))
+17 ;
+18 ;IEN of User who Inactivated this patient.
IF E]""
SET J=$GET(DUZ)
+19 ;
+20 SET DATA=A_U_B_U_C_U_D_U_E_U_F_U_G_U_H_U_I_U_$GET(J)_U_K
+21 ;
+22 ;---> Store edits to database.
+23 DO EDITCAS^BIRPC4(.BIERR,DATA)
+24 ;
+25 ;---> If an error is passed back, display it.
+26 SET BIERR=$PIECE(BIERR,BI31,2)
+27 IF BIERR]""
Begin DoDot:1
+28 WRITE !!," * ",BIERR,!?3,"Edits to Patient Case Data not saved!"
+29 DO DIRZ^BIUTL3()
End DoDot:1
+30 ;
+31 QUIT
