BIRPC5 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
;;8.5;IMMUNIZATION;**2**;MAY 15,2012
;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
;; RETURN IMMUNIZATION CONTRAINDICATIONS, CASE DATA, AND LAST LETTER.
; PATCH 2: New Public Entry Point to automatically add Lot Number. ADDLOT+0
;
;
;----------
CONTRAS(BICONTR,BIDFN) ;PEP - Return Patient's Contraindications and their Reasons.
;---> Return Patient's Contraindications and their Reasons.
;---> Contraindications returned in one string, delimited by "^".
;---> Each Contra has 3 "|" pieces: Vaccine Name|Reason|Date Entered.
;---> Parameters:
; 1 - BICONTR (ret) String of patient's Contraindications_||_Error.
; 2 - BIDFN (req) DFN of patient.
;
;---> Delimiter to pass error with result to GUI.
N BI31,BIERR,U,V S BI31=$C(31)_$C(31),U="^",V="|"
S BICONTR="",BIERR=""
;
;---> If DFN not provided, set Error Code and quit.
I '$G(BIDFN) D Q
.D ERRCD^BIUTL2(308,.BIERR) S BICONTR=BI31_BIERR
;
N N,X S N=0,X=""
F S N=$O(^BIPC("B",BIDFN,N)) Q:'N D
.;
.;---> Kill any false xref.
.I '$D(^BIPC(N,0)) K ^BIPC("B",BIDFN,N) Q
.;
.N Y S Y=^BIPC(N,0)
.;---> Get Contraindication:
.;---> IEN of Contraindication, Vaccine Short Name, Reason, Date.
.S X=X_N_V_$$VNAME^BIUTL2($P(Y,U,2))_V_$$CONTXT^BIUTL6($P(Y,U,3))
.S X=X_V_$$TXDT1^BIUTL5($P(Y,U,4))_U
;
S BICONTR=X_BI31
Q
;
;
;----------
CASEDAT(BICASED,BIDFN) ;PEP - Return Patient's Case Data, pieces delimited by "^".
;---> Parameters:
; 1 - BICASED (ret) String of Patient's Case Data_||_Error.
; 2 - BIDFN (req) DFN of patient.
;
;---> Delimiter to pass error with result to GUI.
N BI31,BIERR,U S BI31=$C(31)_$C(31),U="^"
S BICASED="",BIERR=""
;
;---> If DFN not provided, set Error Code and quit.
I '$G(BIDFN) D Q
.D ERRCD^BIUTL2(206,.BIERR) S BICASED=BI31_BIERR
;
;---> If Patient not in Immunization database, set Error Code and quit.
I '$D(^BIP(BIDFN,0)) D Q
.D ERRCD^BIUTL2(204,.BIERR) S BICASED=BI31_BIERR
;
;---> Case Data Elements returned as follows:
;
;---> PC DATA
;---> -- ----
;---> 1 = Text of Case Manager's name.
;---> 2 = Text of Parent or Guardian in Immunization database.
;---> 3 = Mother's HBsAG Status Code (P,N,A,U).
;---> 4 = Date Patient became Inactive (DD-Mmm-YYYY).
;---> 5 = Reason for Inactive.
;---> 6 = Other Info.
;---> 7 = Forecast Influenza/Pneumococcal.
;---> 8 = Location Moved or Tx Elsewhere.
;---> 9 = State Registry Consent.
;
N X
S X=$$CMGR^BIUTL1(BIDFN,1) S:X="Unknown" X=""
S X=X_U_$$PARENT^BIUTL1(BIDFN)
S X=X_U_$$MOTHER^BIUTL11(BIDFN)
S Z=$$TXDT1^BIUTL5($$INACT^BIUTL1(BIDFN)) S:Z="NO DATE" Z=""
S X=X_U_Z
S X=X_U_$$INACTRE^BIUTL1(BIDFN)_U_$$OTHERIN^BIUTL11(BIDFN)
S X=X_U_$$INFL^BIUTL11(BIDFN)
S X=X_U_$$MOVEDLOC^BIUTL1(BIDFN)
S X=X_U_$$CONSENT^BIUTL1(BIDFN)
;
S BICASED=X_BI31
Q
;
;
;----------
LASTLET(BILASTL,BIDFN) ;EP
;---> Return date of last letter sent to this patient.
;---> Parameters:
; 1 - BILASTL (ret) Date of last letter_||_Error.
; 2 - BIDFN (req) DFN of patient.
;
;---> Delimiter to pass error with result to GUI.
N BI31,BIERR,U S BI31=$C(31)_$C(31),U="^"
S BILASTL="",BIERR=""
;
;---> If DFN not provided, set Error Code and quit.
I '$G(BIDFN) D Q
.D ERRCD^BIUTL2(201,.BIERR) S BILASTL=BI31_BIERR
;
;---> Last Letter Elements returned as follows:
;
;---> PC DATA
;---> -- ----
;---> 1 = Date of last letter (DD-Mmm-YYYY) or "None".
;
S BILASTL=$$LASTLET^BIUTL1(BIDFN,1)_BI31
Q
;
;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
;---> New Public Entry Point to automatically add Lot Number.
;
;
;----------
ADDLOT(BIERR,BIDATA,BIIEN) ;PEP - Add a new Lot Number for imported data.
;---> Add new (imported) Lot Number to the IMMUNIZATION LOT File #9999999.41.
;---> Called by RPC: BI LOT NUMBER ADD.
;---> Parameters:
; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
; 2 - BIDATA (req) String of data for the Lot Number to be added.
; 3 - BIIEN (ret) IEN of newly added Lot Number in ^AUTTIML(.
; NOTE: If Lot Number already exists, BIERR will return
; error #444, but BIIEN will be returned with IEN
; pre-existing Lot Number.
;
;---> Pieces of BIDATA delimited by "|":
; ----------------------------------
; 1 - (req) Text of the Lot Number.
; 2 - (req) CVX Code of the Vaccine associated with this Lot Number.
; 3 - (req) MVX Code of the Manufacturer associated with this Lot Number.
;
;---> Define delimiter to pass error and error variable.
N BI31
S BI31=$C(31)_$C(31),BIERR=""
;
;---> If DATA not supplied, set Error Code and quit.
I $G(BIDATA)']"" D Q
.D ERRCD^BIUTL2(442,.BIERR) S BIERR=BI31_BIERR
;
;---> Set data values in BI local array.
N BI
S BI("AS")=$P(BIDATA,"|",1) ;Full Lot Number Text.
S BI("B")=$P(BIDATA,"|",2) ;CVX Code of Vaccine.
S BI("M")=$P(BIDATA,"|",3) ;MVX Code of Manufacturer.
;
;---> If Lot Number="", quit with error.
I 'BI("AS")']"" D Q
.D ERRCD^BIUTL2(442,.BIERR) S BIERR=BI31_BIERR
;
;---> If Lot Number is too long, quit with error.
I $L(BI("AS"))>19 D Q
.D ERRCD^BIUTL2(443,.BIERR) S BIERR=BI31_BIERR
;
;---> If Lot Number already exists, set BIIEN=IEN, BUT quit with error.
I $D(^AUTTIML("B",BI("AS"))) D Q
.N Y S Y=$O(^AUTTIML("B",BI("AS"),0))
.I $P($G(^AUTTIML(Y,0)),U)=BI("AS") S BIIEN=Y
.D ERRCD^BIUTL2(444,.BIERR) S BIERR=BI31_BIERR
;
;
;---> S BI("B")=IEN of Vaccine.
S BI("B")=$O(^AUTTIMM("C",+$G(BI("B")),0))
;---> If CVX Code is invalid, quit with error.
I 'BI("B") D Q
.D ERRCD^BIUTL2(445,.BIERR) S BIERR=BI31_BIERR
;
;
;---> S BI("M")=IEN of Manufacturer.
;---> If MVX Code is invalid, quit with error.
I BI("M")="" D Q
.D ERRCD^BIUTL2(446,.BIERR) S BIERR=BI31_BIERR
S BI("M")=$O(^AUTTIMAN("C",BI("M"),0))
I BI("M")="" D Q
.D ERRCD^BIUTL2(446,.BIERR) S BIERR=BI31_BIERR
;
;
;---> Build local array for this Lot Number.
S BIFLD(.01)=$G(BI("AS")),BIFLD(.02)=$G(BI("M"))
;---> Imported Lot Number will have a Status of Inactive.
S BIFLD(.03)=1,BIFLD(.04)=$G(BI("B"))
;
;---> Add the Lot Number. BIIEN1(1) will equal IEN of newly added Lot Number.
N BIIEN1
D UPDATE^BIFMAN(9999999.41,.BIIEN1,.BIFLD,.BIERR)
;
;---> If there was an error, return it.
S BIERR=BI31_BIERR
;
;---> Return BIIEN.
S BIIEN=$G(BIIEN1(1))
;
;---> Check IEN.
I $P($G(^AUTTIML(+BIIEN,0)),U)'=BI("AS") D Q
.D ERRCD^BIUTL2(447,.BIERR) S BIERR=BI31_BIERR
;
Q
BIRPC5 ;IHS/CMI/MWR - REMOTE PROCEDURE CALLS; MAY 10, 2010
+1 ;;8.5;IMMUNIZATION;**2**;MAY 15,2012
+2 ;;* MICHAEL REMILLARD, DDS * CIMARRON MEDICAL INFORMATICS, FOR IHS *
+3 ;; RETURN IMMUNIZATION CONTRAINDICATIONS, CASE DATA, AND LAST LETTER.
+4 ; PATCH 2: New Public Entry Point to automatically add Lot Number. ADDLOT+0
+5 ;
+6 ;
+7 ;----------
CONTRAS(BICONTR,BIDFN) ;PEP - Return Patient's Contraindications and their Reasons.
+1 ;---> Return Patient's Contraindications and their Reasons.
+2 ;---> Contraindications returned in one string, delimited by "^".
+3 ;---> Each Contra has 3 "|" pieces: Vaccine Name|Reason|Date Entered.
+4 ;---> Parameters:
+5 ; 1 - BICONTR (ret) String of patient's Contraindications_||_Error.
+6 ; 2 - BIDFN (req) DFN of patient.
+7 ;
+8 ;---> Delimiter to pass error with result to GUI.
+9 NEW BI31,BIERR,U,V
SET BI31=$CHAR(31)_$CHAR(31)
SET U="^"
SET V="|"
+10 SET BICONTR=""
SET BIERR=""
+11 ;
+12 ;---> If DFN not provided, set Error Code and quit.
+13 IF '$GET(BIDFN)
Begin DoDot:1
+14 DO ERRCD^BIUTL2(308,.BIERR)
SET BICONTR=BI31_BIERR
End DoDot:1
QUIT
+15 ;
+16 NEW N,X
SET N=0
SET X=""
+17 FOR
SET N=$ORDER(^BIPC("B",BIDFN,N))
IF 'N
QUIT
Begin DoDot:1
+18 ;
+19 ;---> Kill any false xref.
+20 IF '$DATA(^BIPC(N,0))
KILL ^BIPC("B",BIDFN,N)
QUIT
+21 ;
+22 NEW Y
SET Y=^BIPC(N,0)
+23 ;---> Get Contraindication:
+24 ;---> IEN of Contraindication, Vaccine Short Name, Reason, Date.
+25 SET X=X_N_V_$$VNAME^BIUTL2($PIECE(Y,U,2))_V_$$CONTXT^BIUTL6($PIECE(Y,U,3))
+26 SET X=X_V_$$TXDT1^BIUTL5($PIECE(Y,U,4))_U
End DoDot:1
+27 ;
+28 SET BICONTR=X_BI31
+29 QUIT
+30 ;
+31 ;
+32 ;----------
CASEDAT(BICASED,BIDFN) ;PEP - Return Patient's Case Data, pieces delimited by "^".
+1 ;---> Parameters:
+2 ; 1 - BICASED (ret) String of Patient's Case Data_||_Error.
+3 ; 2 - BIDFN (req) DFN of patient.
+4 ;
+5 ;---> Delimiter to pass error with result to GUI.
+6 NEW BI31,BIERR,U
SET BI31=$CHAR(31)_$CHAR(31)
SET U="^"
+7 SET BICASED=""
SET BIERR=""
+8 ;
+9 ;---> If DFN not provided, set Error Code and quit.
+10 IF '$GET(BIDFN)
Begin DoDot:1
+11 DO ERRCD^BIUTL2(206,.BIERR)
SET BICASED=BI31_BIERR
End DoDot:1
QUIT
+12 ;
+13 ;---> If Patient not in Immunization database, set Error Code and quit.
+14 IF '$DATA(^BIP(BIDFN,0))
Begin DoDot:1
+15 DO ERRCD^BIUTL2(204,.BIERR)
SET BICASED=BI31_BIERR
End DoDot:1
QUIT
+16 ;
+17 ;---> Case Data Elements returned as follows:
+18 ;
+19 ;---> PC DATA
+20 ;---> -- ----
+21 ;---> 1 = Text of Case Manager's name.
+22 ;---> 2 = Text of Parent or Guardian in Immunization database.
+23 ;---> 3 = Mother's HBsAG Status Code (P,N,A,U).
+24 ;---> 4 = Date Patient became Inactive (DD-Mmm-YYYY).
+25 ;---> 5 = Reason for Inactive.
+26 ;---> 6 = Other Info.
+27 ;---> 7 = Forecast Influenza/Pneumococcal.
+28 ;---> 8 = Location Moved or Tx Elsewhere.
+29 ;---> 9 = State Registry Consent.
+30 ;
+31 NEW X
+32 SET X=$$CMGR^BIUTL1(BIDFN,1)
IF X="Unknown"
SET X=""
+33 SET X=X_U_$$PARENT^BIUTL1(BIDFN)
+34 SET X=X_U_$$MOTHER^BIUTL11(BIDFN)
+35 SET Z=$$TXDT1^BIUTL5($$INACT^BIUTL1(BIDFN))
IF Z="NO DATE"
SET Z=""
+36 SET X=X_U_Z
+37 SET X=X_U_$$INACTRE^BIUTL1(BIDFN)_U_$$OTHERIN^BIUTL11(BIDFN)
+38 SET X=X_U_$$INFL^BIUTL11(BIDFN)
+39 SET X=X_U_$$MOVEDLOC^BIUTL1(BIDFN)
+40 SET X=X_U_$$CONSENT^BIUTL1(BIDFN)
+41 ;
+42 SET BICASED=X_BI31
+43 QUIT
+44 ;
+45 ;
+46 ;----------
LASTLET(BILASTL,BIDFN) ;EP
+1 ;---> Return date of last letter sent to this patient.
+2 ;---> Parameters:
+3 ; 1 - BILASTL (ret) Date of last letter_||_Error.
+4 ; 2 - BIDFN (req) DFN of patient.
+5 ;
+6 ;---> Delimiter to pass error with result to GUI.
+7 NEW BI31,BIERR,U
SET BI31=$CHAR(31)_$CHAR(31)
SET U="^"
+8 SET BILASTL=""
SET BIERR=""
+9 ;
+10 ;---> If DFN not provided, set Error Code and quit.
+11 IF '$GET(BIDFN)
Begin DoDot:1
+12 DO ERRCD^BIUTL2(201,.BIERR)
SET BILASTL=BI31_BIERR
End DoDot:1
QUIT
+13 ;
+14 ;---> Last Letter Elements returned as follows:
+15 ;
+16 ;---> PC DATA
+17 ;---> -- ----
+18 ;---> 1 = Date of last letter (DD-Mmm-YYYY) or "None".
+19 ;
+20 SET BILASTL=$$LASTLET^BIUTL1(BIDFN,1)_BI31
+21 QUIT
+22 ;
+23 ;********** PATCH 2, v8.5, MAY 15,2012, IHS/CMI/MWR
+24 ;---> New Public Entry Point to automatically add Lot Number.
+25 ;
+26 ;
+27 ;----------
ADDLOT(BIERR,BIDATA,BIIEN) ;PEP - Add a new Lot Number for imported data.
+1 ;---> Add new (imported) Lot Number to the IMMUNIZATION LOT File #9999999.41.
+2 ;---> Called by RPC: BI LOT NUMBER ADD.
+3 ;---> Parameters:
+4 ; 1 - BIERR (ret) Text of Error Code if any, otherwise null.
+5 ; 2 - BIDATA (req) String of data for the Lot Number to be added.
+6 ; 3 - BIIEN (ret) IEN of newly added Lot Number in ^AUTTIML(.
+7 ; NOTE: If Lot Number already exists, BIERR will return
+8 ; error #444, but BIIEN will be returned with IEN
+9 ; pre-existing Lot Number.
+10 ;
+11 ;---> Pieces of BIDATA delimited by "|":
+12 ; ----------------------------------
+13 ; 1 - (req) Text of the Lot Number.
+14 ; 2 - (req) CVX Code of the Vaccine associated with this Lot Number.
+15 ; 3 - (req) MVX Code of the Manufacturer associated with this Lot Number.
+16 ;
+17 ;---> Define delimiter to pass error and error variable.
+18 NEW BI31
+19 SET BI31=$CHAR(31)_$CHAR(31)
SET BIERR=""
+20 ;
+21 ;---> If DATA not supplied, set Error Code and quit.
+22 IF $GET(BIDATA)']""
Begin DoDot:1
+23 DO ERRCD^BIUTL2(442,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+24 ;
+25 ;---> Set data values in BI local array.
+26 NEW BI
+27 ;Full Lot Number Text.
SET BI("AS")=$PIECE(BIDATA,"|",1)
+28 ;CVX Code of Vaccine.
SET BI("B")=$PIECE(BIDATA,"|",2)
+29 ;MVX Code of Manufacturer.
SET BI("M")=$PIECE(BIDATA,"|",3)
+30 ;
+31 ;---> If Lot Number="", quit with error.
+32 IF 'BI("AS")']""
Begin DoDot:1
+33 DO ERRCD^BIUTL2(442,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+34 ;
+35 ;---> If Lot Number is too long, quit with error.
+36 IF $LENGTH(BI("AS"))>19
Begin DoDot:1
+37 DO ERRCD^BIUTL2(443,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+38 ;
+39 ;---> If Lot Number already exists, set BIIEN=IEN, BUT quit with error.
+40 IF $DATA(^AUTTIML("B",BI("AS")))
Begin DoDot:1
+41 NEW Y
SET Y=$ORDER(^AUTTIML("B",BI("AS"),0))
+42 IF $PIECE($GET(^AUTTIML(Y,0)),U)=BI("AS")
SET BIIEN=Y
+43 DO ERRCD^BIUTL2(444,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+44 ;
+45 ;
+46 ;---> S BI("B")=IEN of Vaccine.
+47 SET BI("B")=$ORDER(^AUTTIMM("C",+$GET(BI("B")),0))
+48 ;---> If CVX Code is invalid, quit with error.
+49 IF 'BI("B")
Begin DoDot:1
+50 DO ERRCD^BIUTL2(445,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+51 ;
+52 ;
+53 ;---> S BI("M")=IEN of Manufacturer.
+54 ;---> If MVX Code is invalid, quit with error.
+55 IF BI("M")=""
Begin DoDot:1
+56 DO ERRCD^BIUTL2(446,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+57 SET BI("M")=$ORDER(^AUTTIMAN("C",BI("M"),0))
+58 IF BI("M")=""
Begin DoDot:1
+59 DO ERRCD^BIUTL2(446,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+60 ;
+61 ;
+62 ;---> Build local array for this Lot Number.
+63 SET BIFLD(.01)=$GET(BI("AS"))
SET BIFLD(.02)=$GET(BI("M"))
+64 ;---> Imported Lot Number will have a Status of Inactive.
+65 SET BIFLD(.03)=1
SET BIFLD(.04)=$GET(BI("B"))
+66 ;
+67 ;---> Add the Lot Number. BIIEN1(1) will equal IEN of newly added Lot Number.
+68 NEW BIIEN1
+69 DO UPDATE^BIFMAN(9999999.41,.BIIEN1,.BIFLD,.BIERR)
+70 ;
+71 ;---> If there was an error, return it.
+72 SET BIERR=BI31_BIERR
+73 ;
+74 ;---> Return BIIEN.
+75 SET BIIEN=$GET(BIIEN1(1))
+76 ;
+77 ;---> Check IEN.
+78 IF $PIECE($GET(^AUTTIML(+BIIEN,0)),U)'=BI("AS")
Begin DoDot:1
+79 DO ERRCD^BIUTL2(447,.BIERR)
SET BIERR=BI31_BIERR
End DoDot:1
QUIT
+80 ;
+81 QUIT
