Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BIRPC3

BIRPC3.m

Go to the documentation of this file.
  1. BIRPC3 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
  1. ;;8.5;IMMUNIZATION;**10**;MAY 30,2015
  1. ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
  1. ;; ADD/EDIT A VISIT (IMMUNIZATION OR SKIN TEST), DELETE A VISIT.
  1. ;; Check validity of data in several fields.
  1. ;; PATCH 3: If Category=Historical Event, Lot need not be Active.
  1. ;; ADDEDIT+117, LOTCHK+34
  1. ;; PATCH 5: Added BINOM parameter to ADDEDIT P.E.P. for Visit Selection Menu.
  1. ;; ADDEDIT+0
  1. ;; PATCH 5: Ignore 1st piece of zero node; just check for node. ADDEDIT+63
  1. ;; PATCH 9: Added save of Admin Date and VIS Presented Date. ADDEDIT+39
  1. ;; PATCH 10: Added save of Skin Test Lot Number. ADDEDIT+44
  1. ;
  1. ;
  1. ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1. ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
  1. ;---> Added Admin Note, piece 27.
  1. ;----------
  1. ADDEDIT(BIERR,BIDATA,BINOM) ;PEP - Add/Edit an V IMMUNIZATION or V SKIN TEST.
  1. ;---> Add/Edit an V IMMUNIZATION or V SKIN TEST.
  1. ;---> Called by RPC: BI VISIT ADD/EDIT.
  1. ;---> Parameters:
  1. ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
  1. ; 2 - BIDATA (req) String of data for the Visit to be added.
  1. ; 3 - BINOM (opt) 0=Allow display of Visit Selection Menu if site
  1. ; parameter is set. 1=No display (for export).
  1. ;
  1. ;---> Pieces of BIDATA delimited by "|":
  1. ; ----------------------------------
  1. ; 1 - (req) "I"=Immunization Visit, "S"=Skin Text Visit.
  1. ; 2 - (req) DFN of patient.
  1. ; 3 - (req) Vaccine or Skin Test .01 pointer.
  1. ; 4 - (opt) Dose# number for this Immunization (NO LONGER USED).
  1. ; 5 - (opt) Lot number IEN for this Immunization.
  1. ; 6 - (req) Date.Time of Visit.
  1. ; 7 - (req) Location of encounter IEN.
  1. ; 8 - (opt) Other Location of encounter.
  1. ; 9 - (req) Category: A (Ambul), I (Inpat), E (Event/Hist)
  1. ; 10 - (opt) Visit IEN.
  1. ; 11 - (opt) Old V File IEN (for edits).
  1. ; 12 - (req) Skin Test Result: P,N,D,O.
  1. ; 13 - (req) Skin Test Reading: 0-40.
  1. ; 14 - (req) Skin Test Date Read.
  1. ; 15 - (opt) Vaccine Reaction.
  1. ; 16 - (opt) VFC Eligibility. vvv83
  1. ; 17 - (opt) Release/Revision Date of VIS.
  1. ; 18 - (opt) IEN of Provider of Immunization/Skin Test.
  1. ; 19 - (opt) Dose Override.
  1. ; 20 - (opt) Injection Site.
  1. ; 21 - (opt) Volume.
  1. ; 22 - (opt) IEN of Reader (Provider) of Skin Test.
  1. ; 23 - (req) DUZ(2) for Site Parameters.
  1. ; 24 - (opt) If this was an imported CPT Coded Imm from PCC (=IEN of V CPT).
  1. ; 25 - (opt) If this =1, then imported (IF =2, then was edited after import).
  1. ; 26 - (opt) NDC pointer IEN (to file #9002084.95).
  1. ; 27 - (opt) Administrative Note (<161 chars).
  1. ;
  1. ;********** PATCH 9, v8.5, OCT 01,2014, IHS/CMI/MWR
  1. ;---> Add Admin Date and VIS Presented Date to data being saved.
  1. ; 28 - (opt) Admin Date (Date shot admin'd to patient.
  1. ; 29 - (opt) Date VIS Presented to Patient.
  1. ;
  1. ;********** PATCH 10, v8.5, MAY 30,2015, IHS/CMI/MWR
  1. ; 30 - (opt) Skin Test Lot Number.
  1. ;
  1. ;---> Define delimiter to pass error and error variable.
  1. N BI31,BIDUZ2,BIOIEN
  1. S BI31=$C(31)_$C(31),BIERR=""
  1. ;
  1. ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1. ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
  1. S:($G(BINOM)="") BINOM=0
  1. ;
  1. ;---> If this is an edit of an old Visit, preserve IEN of old V File entry.
  1. S BIOIEN=$P(BIDATA,"|",11)
  1. ;
  1. ;---> If DATA not supplied, set Error Code and quit.
  1. I $G(BIDATA)']"" D Q
  1. .D ERRCD^BIUTL2(403,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> Get Site IEN (passed DUZ(2)) for Site Parameters.
  1. S BIDUZ2=$P(BIDATA,"|",23)
  1. ;---> If no Site IEN was passed, try to get it from local symbol table.
  1. S:'BIDUZ2 (BIDUZ2,$P(BIDATA,"|",23))=$G(DUZ(2))
  1. ;--> If still no Site IEN, error out.
  1. I '$G(BIDUZ2) D ERRCD^BIUTL2(121,.BIERR) S BIERR=BI31_BIERR Q
  1. ;
  1. ;---> Check for valid Patient.
  1. N BIDFN S BIDFN=$P(BIDATA,"|",2)
  1. ;
  1. ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1. ;---> Ignore 1st piece of zero node; just check for node.
  1. ;I '$G(^AUPNPAT(+BIDFN,0)) D Q
  1. I '$D(^AUPNPAT(+BIDFN,0)) D Q
  1. .;**********
  1. .;
  1. .D ERRCD^BIUTL2(217,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> Visit Type: "I"=Immunization Visit, "S"=Skin Text Visit.
  1. ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
  1. ;---> not="S" (Skin Test Visit), then set Error Code and quit.
  1. N BIVTYPE S BIVTYPE=$P(BIDATA,"|",1)
  1. I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D Q
  1. .D ERRCD^BIUTL2(410,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> If this is an Immunization Visit and the Vaccine Table
  1. ;---> not standard, set Error Code and quit.
  1. I (BIVTYPE="I")&($D(^BISITE(-1))) D Q
  1. .D ERRCD^BIUTL2(503,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> If this Visit (new or edited) will be a duplicate, set error
  1. ;---> and quit.
  1. D DUPTEST^BIUTL8(.BIERR,BIDATA,$G(BIOIEN))
  1. Q:BIERR]""
  1. ;
  1. ;---> Reformat dates to Fileman Internal format.
  1. D
  1. .N I F I=6,14,17 D
  1. ..N X S X=$P(BIDATA,"|",I)
  1. ..D DT^DILF("PT",X,.X)
  1. ..S $P(BIDATA,"|",I)=X
  1. ;
  1. ;---> If Visit Date is before Patient's DOB, set Error Code and quit.
  1. I $P(BIDATA,"|",6)<$$DOB^BIUTL1($P(BIDATA,"|",2)) D Q
  1. .D ERRCD^BIUTL2(422,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> Set Lot# and Category.
  1. N BILOT S BILOT=$P(BIDATA,"|",5)
  1. N BICAT S BICAT=$P(BIDATA,"|",9)
  1. ;
  1. ;---> If this is an Immunization, check for valid.
  1. D:BIVTYPE="I" Q:$G(BIERR)]""
  1. .N BIVAC S BIVAC=$P(BIDATA,"|",3)
  1. .;
  1. .;---> If Vaccine not provided, set Error and quit.
  1. .I '$G(BIVAC) D Q
  1. ..D ERRCD^BIUTL2(502,.BIERR) S BIERR=BI31_BIERR
  1. .;
  1. .;---> If Vaccine does not exist, set Error and quit.
  1. .I '$D(^AUTTIMM(BIVAC,0)) D Q
  1. ..D ERRCD^BIUTL2(430,.BIERR) S BIERR=BI31_BIERR
  1. .;
  1. .;---> If the Vaccine is INACTIVE and Category is NOT "Historical Event"
  1. .;---> set Error Code and quit.
  1. .I $P(^AUTTIMM(BIVAC,0),U,7)&(BICAT'="E") D Q
  1. ..D ERRCD^BIUTL2(429,.BIERR) S BIERR=BI31_BIERR
  1. .;
  1. .;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
  1. .;---> Use new call, LOTCHK, to check validity of Lot Number.
  1. .;---> If Lot# is required and one was not passed, set Error and quit.
  1. .;---> (If Category is Historical Event, Lot# not required.)
  1. .I $$LOTREQ^BIUTL2(BIDUZ2)&(BILOT="")&(BICAT'="E") D Q
  1. ..D ERRCD^BIUTL2(431,.BIERR) S BIERR=BI31_BIERR
  1. .;
  1. .;---> If Lot Number was passed, check it.
  1. .D:BILOT Q:$G(BIERR)]""
  1. ..;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1. ..;---> If Category=Historical Event, Lot need not be Active.
  1. ..;D LOTCHK(BILOT,BIVAC,.BIERR)
  1. ..D LOTCHK(BILOT,BIVAC,BICAT,.BIERR)
  1. ..;**********
  1. ..;
  1. ..I $G(BIERR)]"" S BIERR=BI31_BIERR
  1. ;
  1. ;---> If this is a Skin Test, Category is NOT Historical, and it has a Result,
  1. ;---> then check for Reading in mm.
  1. I BIVTYPE="S",BICAT'="E",$P(BIDATA,"|",12)]"",$P(BIDATA,"|",13)="" D Q
  1. .D ERRCD^BIUTL2(436,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;
  1. ;---> Add Visit.
  1. ;********** PATCH 5, v8.5, JUL 01,2013, IHS/CMI/MWR
  1. ;---> Added BINOM parameter to ADDEDIT P.E.P., to control Visit Menu display.
  1. ;D ADDV^BIVISIT(.BIERR,BIDATA)
  1. D ADDV^BIVISIT(.BIERR,BIDATA,,BINOM)
  1. ;
  1. ;---> If add Visit fails, then return error and quit;
  1. ;---> do NOT delete the old Visit.
  1. I BIERR S BIERR=BI31_$P(BIERR,U,2) Q
  1. ;
  1. ;---> If this is an Edit of an old Visit, then DELETE the old V File entry.
  1. I $G(BIOIEN) D DELETE(.BIERR,BIOIEN,BIVTYPE) Q
  1. ;
  1. ;---> Since this was a New Visit (not an Edit), decrement the Lot Total.
  1. I $G(BILOT) D LOTDECR(BILOT)
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. LOTDECR(BILOT) ;PEP - Decrement Lot Total for a given Lot Number.
  1. ;---> Parameters:
  1. ; 1 - BILOT (req) Lot Number IEN for this Immunization.
  1. ;
  1. Q:'$G(BILOT) Q:'$D(^AUTTIML(BILOT,0))
  1. N X,Y,Z S X=^AUTTIML(BILOT,0),Y=$P(X,U,11),Z=$P(X,U,12)
  1. ;---> Quit if no Starting Amount (i.e., not tracked).
  1. Q:Y=""
  1. ;---> Okay, decrement Number Unused by 1.
  1. S $P(^AUTTIML(BILOT,0),U,12)=Z-1
  1. ;
  1. Q
  1. ;
  1. ;
  1. ;----------
  1. LOTRBAL(BILIEN) ;PEP - Return Remaining Balance (Starting Total - Number Used).
  1. ;---> Parameters:
  1. ; 1 - BILIEN (req) Lot Number IEN for this Immunization.
  1. ;
  1. N BIERR
  1. I '$G(BILIEN) D ERRCD^BIUTL2(511,.BIERR) Q BIERR
  1. I '$D(^AUTTIML(BILIEN,0)) D ERRCD^BIUTL2(512,.BIERR) Q BIERR
  1. N X,Y,Z S X=^AUTTIML(BILIEN,0),Y=$P(X,U,11),Z=$P(X,U,12)
  1. Q:(Y="") "Not tracked"
  1. Q +Z
  1. ;
  1. ;
  1. ;----------
  1. LOTEXP(BILIEN,BIYY) ;PEP - Return Lot Expiration Date in format: MM/DD/YYYY.
  1. ;---> Parameters:
  1. ; 1 - BILIEN (req) Lot Number IEN for this Immunization.
  1. ; 2 - BIYY (opt) If BIYY=1, return 2-digit year: MM/DD/YY.
  1. ; If BIYY=2, return Fileman format of date.
  1. ;
  1. I '$G(BILIEN) D ERRCD^BIUTL2(511,.BIERR) Q BIERR
  1. I '$D(^AUTTIML(BILIEN,0)) D ERRCD^BIUTL2(512,.BIERR) Q BIERR
  1. N BIDATE S BIDATE=$P(^AUTTIML(BILIEN,0),U,9)
  1. Q:($G(BIYY)=2) BIDATE
  1. Q $$SLDT2^BIUTL5(BIDATE,$G(BIYY))
  1. ;
  1. ;
  1. ;********** PATCH 1, v8.2.1, FEB 01,2008, IHS/CMI/MWR
  1. ;---> New LOTCHK subroutine to combine all checks for valid Lot Number.
  1. ;----------
  1. LOTCHK(BILOT,BIVAC,BICAT,BIERR) ;EP
  1. ;---> Check for valid Lot Number given the Vaccine passed.
  1. ;---> Parameters:
  1. ; 1 - BILOT (req) IEN of Lot Number.
  1. ; 2 - BIVAC (req) IEN of Vaccine IMMUNIZATION File (9999999.14).
  1. ; 3 - BICAT (opt) Category of Visit.
  1. ; 4 - BIERR (ret) Text of Error Code if any, otherwise null.
  1. ;
  1. ;---> Check a) Valid Vaccine and Lot Number
  1. ;---> b) Lot Number has been assigned to the Vaccine passed;
  1. ;---> b) Lot Number is Active
  1. ;---> c) Lot Number does not have duplicates
  1. ;
  1. S BIERR=""
  1. ;
  1. ;---> If Lot# IEN not passed, set Error and quit.
  1. I '$G(BILOT) D ERRCD^BIUTL2(511,.BIERR) Q
  1. ;
  1. ;---> If Vaccine IEN not passed, set Error and quit.
  1. I '$G(BILOT) D ERRCD^BIUTL2(502,.BIERR) Q
  1. ;
  1. ;---> Set Y=^AUTTIML(BILOT,0).
  1. N Y S Y=$G(^AUTTIML(BILOT,0))
  1. ;
  1. ;---> If Lot# does not exist, set Error and quit.
  1. I Y="" D Q
  1. .D ERRCD^BIUTL2(512,.BIERR)
  1. ;
  1. ;---> If this Lot# does NOT point back to this Vaccine, set Error and quit.
  1. I $P(Y,U,4)'=BIVAC D ERRCD^BIUTL2(513,.BIERR) Q
  1. ;
  1. ;---> If the Lot# is INACTIVE (attempted save of earlier visit
  1. ;---> with Lot# previously chosen), set Error Code and quit.
  1. ;
  1. ;********** PATCH 3, v8.5, SEP 10,2012, IHS/CMI/MWR
  1. ;---> If Category=Historical Event, Lot need not be Active.
  1. ;I $P(Y,U,3) D ERRCD^BIUTL2(426,.BIERR) Q
  1. I ($P(Y,U,3)&($G(BICAT)'="E")) D ERRCD^BIUTL2(426,.BIERR) Q
  1. ;**********
  1. ;
  1. ;---> If Lot# is duplicated in the IMM LOT File, set Error and quit.
  1. I $$LOTDUP^BIUTL4(BILOT) D ERRCD^BIUTL2(427,.BIERR)
  1. ;
  1. Q
  1. ;**********
  1. ;
  1. ;
  1. ;----------
  1. DELETE(BIERR,BIDA,BIVTYPE) ;PEP - Delete an Immunization or Skin Test.
  1. ;---> Delete an Immunization or Skin Test.
  1. ;---> Called by RPC: BI VISIT DELETE.
  1. ;---> Parameters:
  1. ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
  1. ; 2 - BIDA (req) IEN of V IMM or V SKIN entry to be deleted.
  1. ; 3 - BIVTYPE (req) "I"=Immunization Visit, "S"=Skin Text Visit.
  1. ;
  1. ;---> Define delimiter to pass error and error variable.
  1. N BI31 S BI31=$C(31)_$C(31),BIERR=""
  1. ;
  1. ;---> If DA not supplied, set Error Code and quit.
  1. I '$G(BIDA) D Q
  1. .D ERRCD^BIUTL2(404,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> If BIVTYPE does not="I" (Immunization Visit) and it does
  1. ;---> not="S" (Skin Test Visit), then set Error Code and quit.
  1. I ($G(BIVTYPE)'="I")&($G(BIVTYPE)'="S") D Q
  1. .D ERRCD^BIUTL2(410,.BIERR) S BIERR=BI31_BIERR
  1. ;
  1. ;---> Delete V IMMUNIZATION entry.
  1. D DELETE^BIVISIT2(BIDA,BIVTYPE,.BIERR) S BIERR=BI31_BIERR
  1. Q