- 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