BIRPC3 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
;;8.5;IMMUNIZATION;**10**;MAY 30,2015
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; ADD/EDIT A VISIT (IMMUNIZATION OR SKIN TEST), DELETE A VISIT.
;; Check validity of data in several fields.
;; PATCH 3: If Category=Historical Event, Lot need not be Active.
;; ADDEDIT+117, LOTCHK+34
;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu.
;; ADDEDIT+0
;; PATCH 5: Ignore 1st piece of zero node; just check for node. ADDEDIT+63
;; PATCH 9: Added save of Admin Date and VIS Presented Date. ADDEDIT+39
;; PATCH 10: Added save of Skin Test Lot Number. ADDEDIT+44
;
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
;---> Added Admin Note, piece 27.
;----------
ADDEDIT(BIERR,BIDATA,BINOM) ;PEP - Add/Edit an V IMMUNIZATION or V SKIN TEST.
;---> Add/Edit an V IMMUNIZATION or V SKIN TEST.
;---> Called by RPC: BI VISIT ADD/EDIT.
;---> Parameters:
; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
; 2 - BIDATA (req) String of data for the Visit to be added.
; 3 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
; parameter is set. 1=No display (for export).
;
;---> Pieces of BIDATA delimited by "|":
; ----------------------------------
; 1 - (req) "I"=Immunization Visit, "S"=Skin Text Visit.
; 2 - (req) DFN of patient.
; 3 - (req) Vaccine or Skin Test .01 pointer.
; 4 - (opt) Dose# number for this Immunization (NO LONGER USED).
; 5 - (opt) Lot number IEN for this Immunization.
; 6 - (req) Date.Time of Visit.
; 7 - (req) Location of encounter IEN.
; 8 - (opt) Other Location of encounter.
; 9 - (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
; 10 - (opt) Visit IEN.
; 11 - (opt) Old V File IEN (for edits).
; 12 - (req) Skin Test Result: P,N,D,O.
; 13 - (req) Skin Test Reading: 0-40.
; 14 - (req) Skin Test Date Read.
; 15 - (opt) Vaccine Reaction.
; 16 - (opt) VFC Eligibility. vvv83
; 17 - (opt) Release/Revision Date of VIS.
; 18 - (opt) IEN of Provider of Immunization/Skin Test.
; 19 - (opt) Dose Override.
; 20 - (opt) Injection Site.
; 21 - (opt) Volume.
; 22 - (opt) IEN of Reader (Provider) of Skin Test.
; 23 - (req) DUZ(2) for Site Parameters.
; 24 - (opt) If this was an imported CPT Coded Imm from PCC (=IEN of V CPT).
; 25 - (opt) If this =1, then imported (IF =2, then was edited after import).
; 26 - (opt) NDC pointer IEN (to file #9002084.95).
; 27 - (opt) Administrative Note (<161 chars).
;
;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
;---> Add Admin Date and VIS Presented Date to data being saved.
; 28 - (opt) Admin Date (Date shot admin'd to patient.
; 29 - (opt) Date VIS Presented to Patient.
;
;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
; 30 - (opt) Skin Test Lot Number.
;
;---> Define delimiter to pass error and error variable.
N BI31,BIDUZ2,BIOIEN
S BI31=$C(31)_$C(31),BIERR=""
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
S:($G(BINOM)="") BINOM=0
;
;---> If this is an edit of an old Visit, preserve IEN of old V File entry.
S BIOIEN=$P(BIDATA,"|",11)
;
;---> If DATA not supplied, set Error Code and quit.
I $G(BIDATA)']"" D Q
.D ERRCD^BIUTL2(403,.BIERR) S BIERR=BI31_BIERR
;
;---> Get Site IEN (passed DUZ(2)) for Site Parameters.
S BIDUZ2=$P(BIDATA,"|",23)
;---> If no Site IEN was passed, try to get it from local symbol table.
S:'BIDUZ2 (BIDUZ2,$P(BIDATA,"|",23))=$G(DUZ(2))
;--> If still no Site IEN, error out.
I '$G(BIDUZ2) D ERRCD^BIUTL2(121,.BIERR) S BIERR=BI31_BIERR Q
;
;---> Check for valid Patient.
N BIDFN S BIDFN=$P(BIDATA,"|",2)
;
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Ignore 1st piece of zero node; just check for node.
;I '$G(^AUPNPAT(+BIDFN,0)) D Q
I '$D(^AUPNPAT(+BIDFN,0)) D Q
.;**********
.;
.D ERRCD^BIUTL2(217,.BIERR) S BIERR=BI31_BIERR
;
;---> Visit Type: "I"=Immunization Visit, "S"=Skin Text Visit.
;---> If BIVTYPE does not="I" (Immunization Visit) and it does
;---> not="S" (Skin Test Visit), then set Error Code and quit.
N BIVTYPE S BIVTYPE=$P(BIDATA,"|",1)
I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D Q
.D ERRCD^BIUTL2(410,.BIERR) S BIERR=BI31_BIERR
;
;---> If this is an Immunization Visit and the Vaccine Table
;---> not standard, set Error Code and quit.
I (BIVTYPE="I")&($D(^BISITE(-1))) D Q
.D ERRCD^BIUTL2(503,.BIERR) S BIERR=BI31_BIERR
;
;---> If this Visit (new or edited) will be a duplicate, set error
;---> and quit.
D DUPTEST^BIUTL8(.BIERR,BIDATA,$G(BIOIEN))
Q:BIERR]""
;
;---> Reformat dates to Fileman Internal format.
D
.N I F I=6,14,17 D
..N X S X=$P(BIDATA,"|",I)
..D DT^DILF("PT",X,.X)
..S $P(BIDATA,"|",I)=X
;
;---> If Visit Date is before Patient's DOB, set Error Code and quit.
I $P(BIDATA,"|",6)<$$DOB^BIUTL1($P(BIDATA,"|",2)) D Q
.D ERRCD^BIUTL2(422,.BIERR) S BIERR=BI31_BIERR
;
;---> Set Lot# and Category.
N BILOT S BILOT=$P(BIDATA,"|",5)
N BICAT S BICAT=$P(BIDATA,"|",9)
;
;---> If this is an Immunization, check for valid.
D:BIVTYPE="I" Q:$G(BIERR)]""
.N BIVAC S BIVAC=$P(BIDATA,"|",3)
.;
.;---> If Vaccine not provided, set Error and quit.
.I '$G(BIVAC) D Q
..D ERRCD^BIUTL2(502,.BIERR) S BIERR=BI31_BIERR
.;
.;---> If Vaccine does not exist, set Error and quit.
.I '$D(^AUTTIMM(BIVAC,0)) D Q
..D ERRCD^BIUTL2(430,.BIERR) S BIERR=BI31_BIERR
.;
.;---> If the Vaccine is INACTIVE and Category is NOT "Historical Event"
.;---> set Error Code and quit.
.I $P(^AUTTIMM(BIVAC,0),U,7)&(BICAT'="E") D Q
..D ERRCD^BIUTL2(429,.BIERR) S BIERR=BI31_BIERR
.;
.;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
.;---> Use new call, LOTCHK, to check validity of Lot Number.
.;---> If Lot# is required and one was not passed, set Error and quit.
.;---> (If Category is Historical Event, Lot# not required.)
.I $$LOTREQ^BIUTL2(BIDUZ2)&(BILOT="")&(BICAT'="E") D Q
..D ERRCD^BIUTL2(431,.BIERR) S BIERR=BI31_BIERR
.;
.;---> If Lot Number was passed, check it.
.D:BILOT Q:$G(BIERR)]""
..;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
..;---> If Category=Historical Event, Lot need not be Active.
..;D LOTCHK(BILOT,BIVAC,.BIERR)
..D LOTCHK(BILOT,BIVAC,BICAT,.BIERR)
..;**********
..;
..I $G(BIERR)]"" S BIERR=BI31_BIERR
;
;---> If this is a Skin Test, Category is NOT Historical, and it has a Result,
;---> then check for Reading in mm.
I BIVTYPE="S",BICAT'="E",$P(BIDATA,"|",12)]"",$P(BIDATA,"|",13)="" D Q
.D ERRCD^BIUTL2(436,.BIERR) S BIERR=BI31_BIERR
;
;
;---> Add Visit.
;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
;D ADDV^BIVISIT(.BIERR,BIDATA)
D ADDV^BIVISIT(.BIERR,BIDATA,,BINOM)
;
;---> If add Visit fails, then return error and quit;
;---> do NOT delete the old Visit.
I BIERR S BIERR=BI31_$P(BIERR,U,2) Q
;
;---> If this is an Edit of an old Visit, then DELETE the old V File entry.
I $G(BIOIEN) D DELETE(.BIERR,BIOIEN,BIVTYPE) Q
;
;---> Since this was a New Visit (not an Edit), decrement the Lot Total.
I $G(BILOT) D LOTDECR(BILOT)
;
Q
;
;
;----------
LOTDECR(BILOT) ;PEP - Decrement Lot Total for a given Lot Number.
;---> Parameters:
; 1 - BILOT (req) Lot Number IEN for this Immunization.
;
Q:'$G(BILOT) Q:'$D(^AUTTIML(BILOT,0))
N X,Y,Z S X=^AUTTIML(BILOT,0),Y=$P(X,U,11),Z=$P(X,U,12)
;---> Quit if no Starting Amount (i.e., not tracked).
Q:Y=""
;---> Okay, decrement Number Unused by 1.
S $P(^AUTTIML(BILOT,0),U,12)=Z-1
;
Q
;
;
;----------
LOTRBAL(BILIEN) ;PEP - Return Remaining Balance (Starting Total - Number Used).
;---> Parameters:
; 1 - BILIEN (req) Lot Number IEN for this Immunization.
;
N BIERR
I '$G(BILIEN) D ERRCD^BIUTL2(511,.BIERR) Q BIERR
I '$D(^AUTTIML(BILIEN,0)) D ERRCD^BIUTL2(512,.BIERR) Q BIERR
N X,Y,Z S X=^AUTTIML(BILIEN,0),Y=$P(X,U,11),Z=$P(X,U,12)
Q:(Y="") "Not tracked"
Q +Z
;
;
;----------
LOTEXP(BILIEN,BIYY) ;PEP - Return Lot Expiration Date in format: MM/DD/YYYY.
;---> Parameters:
; 1 - BILIEN (req) Lot Number IEN for this Immunization.
; 2 - BIYY (opt) If BIYY=1, return 2-digit year: MM/DD/YY.
; If BIYY=2, return Fileman format of date.
;
I '$G(BILIEN) D ERRCD^BIUTL2(511,.BIERR) Q BIERR
I '$D(^AUTTIML(BILIEN,0)) D ERRCD^BIUTL2(512,.BIERR) Q BIERR
N BIDATE S BIDATE=$P(^AUTTIML(BILIEN,0),U,9)
Q:($G(BIYY)=2) BIDATE
Q $$SLDT2^BIUTL5(BIDATE,$G(BIYY))
;
;
;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
;---> New LOTCHK subroutine to combine all checks for valid Lot Number.
;----------
LOTCHK(BILOT,BIVAC,BICAT,BIERR) ;EP
;---> Check for valid Lot Number given the Vaccine passed.
;---> Parameters:
; 1 - BILOT (req) IEN of Lot Number.
; 2 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
; 3 - BICAT (opt) Category of Visit.
; 4 - BIERR (ret) Text of Error Code if any, otherwise null.
;
;---> Check a) Valid Vaccine and Lot Number
;---> b) Lot Number has been assigned to the Vaccine passed;
;---> b) Lot Number is Active
;---> c) Lot Number does not have duplicates
;
S BIERR=""
;
;---> If Lot# IEN not passed, set Error and quit.
I '$G(BILOT) D ERRCD^BIUTL2(511,.BIERR) Q
;
;---> If Vaccine IEN not passed, set Error and quit.
I '$G(BILOT) D ERRCD^BIUTL2(502,.BIERR) Q
;
;---> Set Y=^AUTTIML(BILOT,0).
N Y S Y=$G(^AUTTIML(BILOT,0))
;
;---> If Lot# does not exist, set Error and quit.
I Y="" D Q
.D ERRCD^BIUTL2(512,.BIERR)
;
;---> If this Lot# does NOT point back to this Vaccine, set Error and quit.
I $P(Y,U,4)'=BIVAC D ERRCD^BIUTL2(513,.BIERR) Q
;
;---> If the Lot# is INACTIVE (attempted save of earlier visit
;---> with Lot# previously chosen), set Error Code and quit.
;
;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
;---> If Category=Historical Event, Lot need not be Active.
;I $P(Y,U,3) D ERRCD^BIUTL2(426,.BIERR) Q
I ($P(Y,U,3)&($G(BICAT)'="E")) D ERRCD^BIUTL2(426,.BIERR) Q
;**********
;
;---> If Lot# is duplicated in the IMM LOT File, set Error and quit.
I $$LOTDUP^BIUTL4(BILOT) D ERRCD^BIUTL2(427,.BIERR)
;
Q
;**********
;
;
;----------
DELETE(BIERR,BIDA,BIVTYPE) ;PEP - Delete an Immunization or Skin Test.
;---> Delete an Immunization or Skin Test.
;---> Called by RPC: BI VISIT DELETE.
;---> Parameters:
; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
; 2 - BIDA (req) IEN of V IMM or V SKIN entry to be deleted.
; 3 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
;
;---> Define delimiter to pass error and error variable.
N BI31 S BI31=$C(31)_$C(31),BIERR=""
;
;---> If DA not supplied, set Error Code and quit.
I '$G(BIDA) D Q
.D ERRCD^BIUTL2(404,.BIERR) S BIERR=BI31_BIERR
;
;---> 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 Q
.D ERRCD^BIUTL2(410,.BIERR) S BIERR=BI31_BIERR
;
;---> Delete V IMMUNIZATION entry.
D DELETE^BIVISIT2(BIDA,BIVTYPE,.BIERR) S BIERR=BI31_BIERR
Q
BIRPC3 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; ADD/EDIT A VISIT (IMMUNIZATION OR SKIN TEST), DELETE A VISIT.
+4 ;; Check validity of data in several fields.
+5 ;; PATCH 3: If Category=Historical Event, Lot need not be Active.
+6 ;; ADDEDIT+117, LOTCHK+34
+7 ;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu.
+8 ;; ADDEDIT+0
+9 ;; PATCH 5: Ignore 1st piece of zero node; just check for node. ADDEDIT+63
+10 ;; PATCH 9: Added save of Admin Date and VIS Presented Date. ADDEDIT+39
+11 ;; PATCH 10: Added save of Skin Test Lot Number. ADDEDIT+44
+12 ;
+13 ;
+14 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+15 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+16 ;---> Added Admin Note, piece 27.
+17 ;----------
ADDEDIT(BIERR,BIDATA,BINOM) ;PEP - Add/Edit an V IMMUNIZATION or V SKIN TEST.
+1 ;---> Add/Edit an V IMMUNIZATION or V SKIN TEST.
+2 ;---> Called by RPC: BI VISIT ADD/EDIT.
+3 ;---> Parameters:
+4 ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
+5 ; 2 - BIDATA (req) String of data for the Visit to be added.
+6 ; 3 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
+7 ; parameter is set. 1=No display (for export).
+8 ;
+9 ;---> Pieces of BIDATA delimited by "|":
+10 ; ----------------------------------
+11 ; 1 - (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+12 ; 2 - (req) DFN of patient.
+13 ; 3 - (req) Vaccine or Skin Test .01 pointer.
+14 ; 4 - (opt) Dose# number for this Immunization (NO LONGER USED).
+15 ; 5 - (opt) Lot number IEN for this Immunization.
+16 ; 6 - (req) Date.Time of Visit.
+17 ; 7 - (req) Location of encounter IEN.
+18 ; 8 - (opt) Other Location of encounter.
+19 ; 9 - (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
+20 ; 10 - (opt) Visit IEN.
+21 ; 11 - (opt) Old V File IEN (for edits).
+22 ; 12 - (req) Skin Test Result: P,N,D,O.
+23 ; 13 - (req) Skin Test Reading: 0-40.
+24 ; 14 - (req) Skin Test Date Read.
+25 ; 15 - (opt) Vaccine Reaction.
+26 ; 16 - (opt) VFC Eligibility. vvv83
+27 ; 17 - (opt) Release/Revision Date of VIS.
+28 ; 18 - (opt) IEN of Provider of Immunization/Skin Test.
+29 ; 19 - (opt) Dose Override.
+30 ; 20 - (opt) Injection Site.
+31 ; 21 - (opt) Volume.
+32 ; 22 - (opt) IEN of Reader (Provider) of Skin Test.
+33 ; 23 - (req) DUZ(2) for Site Parameters.
+34 ; 24 - (opt) If this was an imported CPT Coded Imm from PCC (=IEN of V CPT).
+35 ; 25 - (opt) If this =1, then imported (IF =2, then was edited after import).
+36 ; 26 - (opt) NDC pointer IEN (to file #9002084.95).
+37 ; 27 - (opt) Administrative Note (<161 chars).
+38 ;
+39 ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
+40 ;---> Add Admin Date and VIS Presented Date to data being saved.
+41 ; 28 - (opt) Admin Date (Date shot admin'd to patient.
+42 ; 29 - (opt) Date VIS Presented to Patient.
+43 ;
+44 ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
+45 ; 30 - (opt) Skin Test Lot Number.
+46 ;
+47 ;---> Define delimiter to pass error and error variable.
+48 NEW BI31,BIDUZ2,BIOIEN
+49 SET BI31=$CHAR(31)_$CHAR(31)
SET BIERR=""
+50 ;
+51 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+52 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+53 IF ($GET(BINOM)="")
SET BINOM=0
+54 ;
+55 ;---> If this is an edit of an old Visit, preserve IEN of old V File entry.
+56 SET BIOIEN=$PIECE(BIDATA,"|",11)
+57 ;
+58 ;---> If DATA not supplied, set Error Code and quit.
+59 IF $GET(BIDATA)']""
Begin DoDot:1
+60 DO ERRCD^BIUTL2(403,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+61 ;
+62 ;---> Get Site IEN (passed DUZ(2)) for Site Parameters.
+63 SET BIDUZ2=$PIECE(BIDATA,"|",23)
+64 ;---> If no Site IEN was passed, try to get it from local symbol table.
+65 IF 'BIDUZ2
SET (BIDUZ2,$PIECE(BIDATA,"|",23))=$GET(DUZ(2))
+66 ;--> If still no Site IEN, error out.
+67 IF '$GET(BIDUZ2)
DO ERRCD^BIUTL2(121,.BIERR)
SET BIERR=BI31_BIERR
QUIT
+68 ;
+69 ;---> Check for valid Patient.
+70 NEW BIDFN
SET BIDFN=$PIECE(BIDATA,"|",2)
+71 ;
+72 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+73 ;---> Ignore 1st piece of zero node; just check for node.
+74 ;I '$G(^AUPNPAT(+BIDFN,0)) D Q
+75 IF '$DATA(^AUPNPAT(+BIDFN,0))
Begin DoDot:1
+76 ;**********
+77 ;
+78 DO ERRCD^BIUTL2(217,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+79 ;
+80 ;---> Visit Type: "I"=Immunization Visit, "S"=Skin Text Visit.
+81 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+82 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+83 NEW BIVTYPE
SET BIVTYPE=$PIECE(BIDATA,"|",1)
+84 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+85 DO ERRCD^BIUTL2(410,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+86 ;
+87 ;---> If this is an Immunization Visit and the Vaccine Table
+88 ;---> not standard, set Error Code and quit.
+89 IF (BIVTYPE="I")&($DATA(^BISITE(-1)))
Begin DoDot:1
+90 DO ERRCD^BIUTL2(503,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+91 ;
+92 ;---> If this Visit (new or edited) will be a duplicate, set error
+93 ;---> and quit.
+94 DO DUPTEST^BIUTL8(.BIERR,BIDATA,$GET(BIOIEN))
+95 IF BIERR]""
QUIT
+96 ;
+97 ;---> Reformat dates to Fileman Internal format.
+98 Begin DoDot:1
+99 NEW I
FOR I=6,14,17
Begin DoDot:2
+100 NEW X
SET X=$PIECE(BIDATA,"|",I)
+101 DO DT^DILF("PT",X,.X)
+102 SET $PIECE(BIDATA,"|",I)=X
End DoDot:2
End DoDot:1
+103 ;
+104 ;---> If Visit Date is before Patient's DOB, set Error Code and quit.
+105 IF $PIECE(BIDATA,"|",6)<$$DOB^BIUTL1($PIECE(BIDATA,"|",2))
Begin DoDot:1
+106 DO ERRCD^BIUTL2(422,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+107 ;
+108 ;---> Set Lot# and Category.
+109 NEW BILOT
SET BILOT=$PIECE(BIDATA,"|",5)
+110 NEW BICAT
SET BICAT=$PIECE(BIDATA,"|",9)
+111 ;
+112 ;---> If this is an Immunization, check for valid.
+113 IF BIVTYPE="I"
Begin DoDot:1
+114 NEW BIVAC
SET BIVAC=$PIECE(BIDATA,"|",3)
+115 ;
+116 ;---> If Vaccine not provided, set Error and quit.
+117 IF '$GET(BIVAC)
Begin DoDot:2
+118 DO ERRCD^BIUTL2(502,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:2
QUIT
+119 ;
+120 ;---> If Vaccine does not exist, set Error and quit.
+121 IF '$DATA(^AUTTIMM(BIVAC,0))
Begin DoDot:2
+122 DO ERRCD^BIUTL2(430,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:2
QUIT
+123 ;
+124 ;---> If the Vaccine is INACTIVE and Category is NOT "Historical Event"
+125 ;---> set Error Code and quit.
+126 IF $PIECE(^AUTTIMM(BIVAC,0),U,7)&(BICAT'="E")
Begin DoDot:2
+127 DO ERRCD^BIUTL2(429,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:2
QUIT
+128 ;
+129 ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
+130 ;---> Use new call, LOTCHK, to check validity of Lot Number.
+131 ;---> If Lot# is required and one was not passed, set Error and quit.
+132 ;---> (If Category is Historical Event, Lot# not required.)
+133 IF $$LOTREQ^BIUTL2(BIDUZ2)&(BILOT="")&(BICAT'="E")
Begin DoDot:2
+134 DO ERRCD^BIUTL2(431,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:2
QUIT
+135 ;
+136 ;---> If Lot Number was passed, check it.
+137 IF BILOT
Begin DoDot:2
+138 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+139 ;---> If Category=Historical Event, Lot need not be Active.
+140 ;D LOTCHK(BILOT,BIVAC,.BIERR)
+141 DO LOTCHK(BILOT,BIVAC,BICAT,.BIERR)
+142 ;**********
+143 ;
+144 IF $GET(BIERR)]""
SET BIERR=BI31_BIERR
End DoDot:2
IF $GET(BIERR)]""
QUIT
End DoDot:1
IF $GET(BIERR)]""
QUIT
+145 ;
+146 ;---> If this is a Skin Test, Category is NOT Historical, and it has a Result,
+147 ;---> then check for Reading in mm.
+148 IF BIVTYPE="S"
IF BICAT'="E"
IF $PIECE(BIDATA,"|",12)]""
IF $PIECE(BIDATA,"|",13)=""
Begin DoDot:1
+149 DO ERRCD^BIUTL2(436,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+150 ;
+151 ;
+152 ;---> Add Visit.
+153 ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
+154 ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
+155 ;D ADDV^BIVISIT(.BIERR,BIDATA)
+156 DO ADDV^BIVISIT(.BIERR,BIDATA,,BINOM)
+157 ;
+158 ;---> If add Visit fails, then return error and quit;
+159 ;---> do NOT delete the old Visit.
+160 IF BIERR
SET BIERR=BI31_$PIECE(BIERR,U,2)
QUIT
+161 ;
+162 ;---> If this is an Edit of an old Visit, then DELETE the old V File entry.
+163 IF $GET(BIOIEN)
DO DELETE(.BIERR,BIOIEN,BIVTYPE)
QUIT
+164 ;
+165 ;---> Since this was a New Visit (not an Edit), decrement the Lot Total.
+166 IF $GET(BILOT)
DO LOTDECR(BILOT)
+167 ;
+168 QUIT
+169 ;
+170 ;
+171 ;----------
LOTDECR(BILOT) ;PEP - Decrement Lot Total for a given Lot Number.
+1 ;---> Parameters:
+2 ; 1 - BILOT (req) Lot Number IEN for this Immunization.
+3 ;
+4 IF '$GET(BILOT)
QUIT
IF '$DATA(^AUTTIML(BILOT,0))
QUIT
+5 NEW X,Y,Z
SET X=^AUTTIML(BILOT,0)
SET Y=$PIECE(X,U,11)
SET Z=$PIECE(X,U,12)
+6 ;---> Quit if no Starting Amount (i.e., not tracked).
+7 IF Y=""
QUIT
+8 ;---> Okay, decrement Number Unused by 1.
+9 SET $PIECE(^AUTTIML(BILOT,0),U,12)=Z-1
+10 ;
+11 QUIT
+12 ;
+13 ;
+14 ;----------
LOTRBAL(BILIEN) ;PEP - Return Remaining Balance (Starting Total - Number Used).
+1 ;---> Parameters:
+2 ; 1 - BILIEN (req) Lot Number IEN for this Immunization.
+3 ;
+4 NEW BIERR
+5 IF '$GET(BILIEN)
DO ERRCD^BIUTL2(511,.BIERR)
QUIT BIERR
+6 IF '$DATA(^AUTTIML(BILIEN,0))
DO ERRCD^BIUTL2(512,.BIERR)
QUIT BIERR
+7 NEW X,Y,Z
SET X=^AUTTIML(BILIEN,0)
SET Y=$PIECE(X,U,11)
SET Z=$PIECE(X,U,12)
+8 IF (Y="")
QUIT "Not tracked"
+9 QUIT +Z
+10 ;
+11 ;
+12 ;----------
LOTEXP(BILIEN,BIYY) ;PEP - Return Lot Expiration Date in format: MM/DD/YYYY.
+1 ;---> Parameters:
+2 ; 1 - BILIEN (req) Lot Number IEN for this Immunization.
+3 ; 2 - BIYY (opt) If BIYY=1, return 2-digit year: MM/DD/YY.
+4 ; If BIYY=2, return Fileman format of date.
+5 ;
+6 IF '$GET(BILIEN)
DO ERRCD^BIUTL2(511,.BIERR)
QUIT BIERR
+7 IF '$DATA(^AUTTIML(BILIEN,0))
DO ERRCD^BIUTL2(512,.BIERR)
QUIT BIERR
+8 NEW BIDATE
SET BIDATE=$PIECE(^AUTTIML(BILIEN,0),U,9)
+9 IF ($GET(BIYY)=2)
QUIT BIDATE
+10 QUIT $$SLDT2^BIUTL5(BIDATE,$GET(BIYY))
+11 ;
+12 ;
+13 ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
+14 ;---> New LOTCHK subroutine to combine all checks for valid Lot Number.
+15 ;----------
LOTCHK(BILOT,BIVAC,BICAT,BIERR) ;EP
+1 ;---> Check for valid Lot Number given the Vaccine passed.
+2 ;---> Parameters:
+3 ; 1 - BILOT (req) IEN of Lot Number.
+4 ; 2 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
+5 ; 3 - BICAT (opt) Category of Visit.
+6 ; 4 - BIERR (ret) Text of Error Code if any, otherwise null.
+7 ;
+8 ;---> Check a) Valid Vaccine and Lot Number
+9 ;---> b) Lot Number has been assigned to the Vaccine passed;
+10 ;---> b) Lot Number is Active
+11 ;---> c) Lot Number does not have duplicates
+12 ;
+13 SET BIERR=""
+14 ;
+15 ;---> If Lot# IEN not passed, set Error and quit.
+16 IF '$GET(BILOT)
DO ERRCD^BIUTL2(511,.BIERR)
QUIT
+17 ;
+18 ;---> If Vaccine IEN not passed, set Error and quit.
+19 IF '$GET(BILOT)
DO ERRCD^BIUTL2(502,.BIERR)
QUIT
+20 ;
+21 ;---> Set Y=^AUTTIML(BILOT,0).
+22 NEW Y
SET Y=$GET(^AUTTIML(BILOT,0))
+23 ;
+24 ;---> If Lot# does not exist, set Error and quit.
+25 IF Y=""
Begin DoDot:1
+26 DO ERRCD^BIUTL2(512,.BIERR)
End DoDot:1
QUIT
+27 ;
+28 ;---> If this Lot# does NOT point back to this Vaccine, set Error and quit.
+29 IF $PIECE(Y,U,4)'=BIVAC
DO ERRCD^BIUTL2(513,.BIERR)
QUIT
+30 ;
+31 ;---> If the Lot# is INACTIVE (attempted save of earlier visit
+32 ;---> with Lot# previously chosen), set Error Code and quit.
+33 ;
+34 ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
+35 ;---> If Category=Historical Event, Lot need not be Active.
+36 ;I $P(Y,U,3) D ERRCD^BIUTL2(426,.BIERR) Q
+37 IF ($PIECE(Y,U,3)&($GET(BICAT)'="E"))
DO ERRCD^BIUTL2(426,.BIERR)
QUIT
+38 ;**********
+39 ;
+40 ;---> If Lot# is duplicated in the IMM LOT File, set Error and quit.
+41 IF $$LOTDUP^BIUTL4(BILOT)
DO ERRCD^BIUTL2(427,.BIERR)
+42 ;
+43 QUIT
+44 ;**********
+45 ;
+46 ;
+47 ;----------
DELETE(BIERR,BIDA,BIVTYPE) ;PEP - Delete an Immunization or Skin Test.
+1 ;---> Delete an Immunization or Skin Test.
+2 ;---> Called by RPC: BI VISIT DELETE.
+3 ;---> Parameters:
+4 ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
+5 ; 2 - BIDA (req) IEN of V IMM or V SKIN entry to be deleted.
+6 ; 3 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
+7 ;
+8 ;---> Define delimiter to pass error and error variable.
+9 NEW BI31
SET BI31=$CHAR(31)_$CHAR(31)
SET BIERR=""
+10 ;
+11 ;---> If DA not supplied, set Error Code and quit.
+12 IF '$GET(BIDA)
Begin DoDot:1
+13 DO ERRCD^BIUTL2(404,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+14 ;
+15 ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
+16 ;---> not="S" (Skin Test Visit), then set Error Code and quit.
+17 IF ($GET(BIVTYPE)'="I")&($GET(BIVTYPE)'="S")
Begin DoDot:1
+18 DO ERRCD^BIUTL2(410,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+19 ;
+20 ;---> Delete V IMMUNIZATION entry.
+21 DO DELETE^BIVISIT2(BIDA,BIVTYPE,.BIERR)
SET BIERR=BI31_BIERR
+22 QUIT
