PXAPIIM ;ISP/LMT - PCE Immunization APIs ;Aug 16, 2023@14:05
;;1.0;PCE PATIENT CARE ENCOUNTER;**210,215,217,236**;Aug 12, 1996;Build 17
;
; Reference to NAME in file .85 is supported by ICR #6062
;
Q
;
VIS(PXRESULT,PXVIS,PXDATE) ;Called from VIS^PXAPI
;
;Input:
; PXRESULT (required) Return value (passed by reference)
; PXVIS (required) Pointer to #920
; PXDATE (optional; defaults to NOW) The date in FileMan format.
; Used to check the status of the VIS on that date.
;Returns:
; PXRESULT("NAME") = VIS Name
; PXRESULT("EDITION DATE") = FileManager Internal Format for date/time
; PXRESULT("EDITION STATUS") = code^value (C^CURRENT or H^HISTORIC)
; PXRESULT("LANGUAGE") = IEN ^ Language (e.g., 1^ENGLISH)
; PXRESULT("2D BAR CODE") = Barcode from the CDC VIS barcode lookup table
; PXRESULT("VIS URL") = Internet URL for this VIS
; PXRESULT("STATUS") = Status based on PXDATE (1^ACTIVE or 0^INACTIVE)
;
N PXDATA,PXFILE,PXIENS,PXLANG,PXSTATUS
;
S PXFILE=920
S PXIENS=PXVIS_","
D GETS^DIQ(PXFILE,PXIENS,"*","EI","PXDATA")
;
S PXRESULT("NAME")=$G(PXDATA(PXFILE,PXIENS,.01,"E"))
S PXRESULT("EDITION DATE")=$G(PXDATA(PXFILE,PXIENS,.02,"I"))
S PXRESULT("EDITION STATUS")=$G(PXDATA(PXFILE,PXIENS,.03,"I"))_U_$G(PXDATA(PXFILE,PXIENS,.03,"E"))
S PXRESULT("2D BAR CODE")=$G(PXDATA(PXFILE,PXIENS,100,"E"))
S PXRESULT("VIS URL")=$G(PXDATA(PXFILE,PXIENS,101,"E"))
;
S PXLANG=$G(PXDATA(PXFILE,PXIENS,.04,"I"))
I PXLANG D
. S PXLANG=PXLANG_U_$$GET1^DIQ(.85,PXLANG_",","NAME") ;ICR 6062
S PXRESULT("LANGUAGE")=PXLANG
;
S PXSTATUS=$$GETSTAT^XTID(PXFILE,.01,PXIENS,$G(PXDATE))
S PXRESULT("STATUS")=$P(PXSTATUS,U,1)_U_$P(PXSTATUS,U,3)
;
Q
;
IMMGRP(PXRESULT,PXIMM,PXSKIPNOTLIMITED) ;
;
; Returns a list of immunizations that share the same CVX code and Vaccine Group
; Name(s) as PXIMM, as well as Contraindications that are limited to PXIMM.
;
;Input:
; PXRESULT (required) Return value (passed by reference)
; PXIMM (required) Pointer to #9999999.14
; PXSKIPNOTLIMITED (optional) Boolean flag to exclude (1) or include (0)
; contraindications that are not limited to any
; immunization; default is to include (0)
;
;
;Returns:
; PXRESULT("CVX",CVX_CODE,IMM_IEN) = Immunization Name
; PXRESULT("VG",GROUP_NAME,IMM_IEN) = Immunization Name
; PXRESULT("ICR",CONTRA_VIEN) = Contraindication Name
;
I '$G(PXIMM) Q
D IMMGRP^PXAPIIM2(.PXRESULT,.PXIMM,.PXSKIPNOTLIMITED)
;
Q
;
SKSTAT(PXSK) ;
;
;Returns Skin Test status
;
;Input:
; PXSK - (required) Pointer to #9999999.14
;
;Returns:
; 1: Active
; 0: Inactive
;
I '$G(PXSK) Q ""
Q $$GETSTAT^PXVRPC8(PXSK,DT,1,0)
;
IMMSTAT(PXIMM) ;
;
;Returns Immunization status
;
;Input:
; PXIMM - (required) Pointer to #9999999.14
;
;Returns:
; A: Active
; H: Inactive, but Selectable for Historic
; I: Inactive
;
I '$G(PXIMM) Q ""
I '$D(^AUTTIMM(PXIMM)) Q ""
I $P($G(^AUTTIMM(PXIMM,0)),U,7)="" Q "A"
I $P($G(^AUTTIMM(PXIMM,6)),U,1)="Y" Q "H"
Q "I"
;
IMMNODEF() ; Returns "IMMUNIZATION, NO DEFAULT SELECTED" entry
N PXIMM
S PXIMM=$O(^AUTTIMM("AVUID",5237389,0))
I 'PXIMM S PXIMM=$O(^AUTTIMM("B","IMMUNIZATION, NO DEFAULT SELECTED",0))
Q PXIMM
;
IMMBYNM(PXNAME) ; Finds Immunization that matches on PXNAME and returns IEN
N PXIMM
I $G(PXNAME)="" Q 0
S PXIMM=$O(^AUTTIMM("B",PXNAME,0))
I PXIMM Q PXIMM
S PXIMM=$O(^AUTTIMM("G",PXNAME,0))
I PXIMM Q PXIMM
S PXIMM=$O(^AUTTIMM("H",PXNAME,0))
I PXIMM Q PXIMM
Q 0
;
PATICR(PXRESULT,DFN,PXIMM,PXBDT,PXEDT,PXSKIPFOUR) ;
;
; Finds all of a patient's contraindications/refusals using the following criteria:
; 1. Any current-dated contraindication/refusal for PXIMM AND any immunization
; that shares the same CVX code.
; 2. If the Refused Vaccine Group (#1205) is set to Yes, then include any
; current-dated refusals for an immunization that shares the same vaccine
; group as PXIMM.
; 3. Any current-dated contraindications where the contraindication has PXIMM
; listed in the "Immunization Limited To" multiple.
; 4. Any current-dated contraindications where the contraindication does not have
; anything listed in the "Immunization Limited To" multiple, excluding Severe
; Reaction Previous Dose.
;
; * If PXBDT and PXEDT are null, then "current-dated" means where STOP >= TODAY.
; * If PXBDT and PXEDT are defined, then "current-dated" means where START
; <= PXEDT, and STOP is >= PXBDT.
;
;Input:
; PXRESULT - (required) Return value (passed by reference)
; DFN - (required) Pointer to #2
; PXIMM - (required) Pointer to #9999999.14
; PXBDT - (optional; defaults to TODAY) Begin Search Date
; PXEDT - (optional; defaults to 9999999) End Search Date
; PXSKIPFOUR - (optional; defaults to 0) Boolean flag to exclude (1) or
; include (0) criteria #4 above from
; search; default is include (0)
;
;Returns:
; PXRESULT(DAS) = Visit IEN ^ Contra/Refusal variable pointer | Contra/Refusal Name
; ^ Immunization IEN | Name ^ Warn Until Date ^ D/T Recorded ^ Event D/T
; ^ Encounter Provider IEN | Name ^ Refused Vaccine Group (1/0)
; PXRESULT(DAS,"COMMENTS") = Comments
; When the entry is from IMM CONTRAINDICATION REASONS this is defined:
; PXRESULT(DAS,"CONTRAINDICATION/PRECAUTION")=CONTRAINDICATION/PRECAUTION
;
; * DAS = Pointer to #9000010.707
;
N PXCVX,PXDAS,PXDATA,PXFILE,PXICR,PXIMMB,PXIMMGRP,PXSEARCH,PXSEARCHBY,PXSUB,PXVGN,PXX
;
I '$G(DFN)!('$G(PXIMM)) Q
;
S PXSKIPFOUR=+$G(PXSKIPFOUR)
S PXFILE=9000010.707
;
I $G(PXEDT)="" S PXEDT=9999999
I $G(PXBDT)="" S PXBDT=DT
I PXBDT S PXBDT=PXBDT-.0000001
;
D IMMGRP(.PXIMMGRP,PXIMM,PXSKIPFOUR)
;
; >> Search based off criteria #1 & #2:
;
; PXSEARCH("ALL") - assists in searching based off criteria #1
S PXSEARCH("ALL",PXIMM)=""
S PXCVX=$O(PXIMMGRP("CVX",""))
I PXCVX'="" D
. S PXIMMB=0
. F S PXIMMB=$O(PXIMMGRP("CVX",PXCVX,PXIMMB)) Q:'PXIMMB D
. . S PXSEARCH("ALL",PXIMMB)=""
;
; PXSEARCH("REFUSALS") - assists in searching based off criteria #2
S PXVGN=""
F S PXVGN=$O(PXIMMGRP("VG",PXVGN)) Q:PXVGN="" D
. S PXIMMB=0
. F S PXIMMB=$O(PXIMMGRP("VG",PXVGN,PXIMMB)) Q:'PXIMMB D
. . I '$D(PXSEARCH("ALL",PXIMMB)) S PXSEARCH("REFUSALS",PXIMMB)=""
;
F PXSEARCHBY="ALL","REFUSALS" D
. S PXIMMB=0
. F S PXIMMB=$O(PXSEARCH(PXSEARCHBY,PXIMMB)) Q:'PXIMMB D
. . S PXICR=""
. . F S PXICR=$O(^PXRMINDX(PXFILE,"PIC",DFN,PXIMMB,PXICR)) Q:'PXICR D
. . . I PXSEARCHBY="REFUSALS",PXICR'[920.5 Q
. . . S PXSUB(1)=PXFILE,PXSUB(2)="PIC",PXSUB(3)=DFN,PXSUB(4)=PXIMMB,PXSUB(5)=PXICR
. . . D SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT,PXSEARCHBY)
;
; >> Search based off criteria #3 & #4:
;
S PXICR=""
F S PXICR=$O(PXIMMGRP("ICR",PXICR)) Q:'PXICR D
. S PXIMMB=0
. F S PXIMMB=$O(^PXRMINDX(PXFILE,"PCI",DFN,PXICR,PXIMMB)) Q:'PXIMMB D
. . S PXSUB(1)=PXFILE,PXSUB(2)="PCI",PXSUB(3)=DFN,PXSUB(4)=PXICR,PXSUB(5)=PXIMMB
. . D SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
;
; >> Setup return array fields:
S PXDAS=0
F S PXDAS=$O(PXRESULT(PXDAS)) Q:'PXDAS D
. K PXDATA
. D VICR^PXPXRM(PXDAS,.PXDATA)
. S PXX=$G(PXDATA("VISIT"))
. S PXX=PXX_U_$P($G(PXDATA("CONTRA/REFUSAL")),U,1)_"|"_$P($G(PXDATA("CONTRA/REFUSAL")),U,2)
. S PXX=PXX_U_$P($G(PXDATA("IMMUN")),U,1)_"|"_$P($G(PXDATA("IMMUN")),U,2)
. S PXX=PXX_U_$G(PXDATA("WARN UNTIL DATE"))
. S PXX=PXX_U_$G(PXDATA("D/T RECORDED"))
. S PXX=PXX_U_$G(PXDATA("EVENT D/T"))
. S PXX=PXX_U_$P($G(PXDATA("ENC PROVIDER")),U,1)_"|"_$P($G(PXDATA("ENC PROVIDER")),U,2)
. S PXX=PXX_U_$G(PXDATA("REFUSED VACCINE GROUP"))
. S PXRESULT(PXDAS)=PXX
. I $G(PXDATA("CONTRAINDICATION/PRECAUTION"))'="" S PXRESULT(PXDAS,"CONTRAINDICATION/PRECAUTION")=PXDATA("CONTRAINDICATION/PRECAUTION")
. S PXRESULT(PXDAS,"COMMENTS")=$G(PXDATA("COMMENTS"))
Q
;
SEARCH(PXRESULT,PXSUB,PXBDT,PXEDT,PXSEARCHBY) ; Helper function for PATICR
;
N PXDAS,PXSTART,PXSTOP
;
S PXSTART=0
F S PXSTART=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART)) Q:'PXSTART!(PXEDT<PXSTART) D
. S PXSTOP=PXBDT
. F S PXSTOP=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP)) Q:'PXSTOP D
. . S PXDAS=0
. . F S PXDAS=$O(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP,PXDAS)) Q:'PXDAS D
. . . ; If refusal is only for this vaccine, quit
. . . I $G(PXSEARCHBY)="REFUSALS",$P($G(^AUPNVICR(PXDAS,12)),U,5)=0 Q
. . . S PXRESULT(PXDAS)=""
;
Q
;
SITES(PXRSLT,PXROUTE,PXSORTBY) ;
;
;Returns list of selectable Sites for a given Route
;
;Input:
; PXROUTE - (required) Pointer to #920.2
; PXSORTBY - (optional; defaults to "N")
; "N" - Sort by Name
; "R" - Sort by IEN
;
;Returns:
; - If only a subset of sites are selectable for this route,
; that list will be returned in PXRSLT.
; o If PXSORTBY="N" - PXRSLT(Site_Name)=920_3_IEN ^ HL7 Code
; o If PXSORTBY="R" - PXRSLT(920_3_IEN)=Site_Name ^ HL7 Code
; - If all sites are selectable for this route, the API will return:
; PXRSLT("ALL")=""
; - If no sites are selectable for this route, the API will return:
; PXRSLT("NONE")=""
;
N PXI,PXSITE,PXSITEHL,PXSITENM
;
I '$G(PXROUTE) Q
I '$D(^PXV(920.2,PXROUTE,0)) Q
I $G(PXSORTBY)'?1(1"N",1"R") S PXSORTBY="N"
;
I $D(^PXV(920.6,PXROUTE)) D
. S PXI=0
. F S PXI=$O(^PXV(920.6,PXROUTE,1,PXI)) Q:'PXI D
. . S PXSITE=$P($G(^PXV(920.6,PXROUTE,1,PXI,0)),U,1)
. . S PXSITENM=$P($G(^PXV(920.3,+PXSITE,0)),U,1)
. . S PXSITEHL=$P($G(^PXV(920.3,PXSITE,0)),U,2)
. . I PXSITENM="" Q
. . I PXSORTBY="N" S PXRSLT(PXSITENM)=PXSITE_U_PXSITEHL
. . I PXSORTBY="R" S PXRSLT(PXSITE)=PXSITENM_U_PXSITEHL
. ;
. ; if this route exists in 920.6, but is not mapped to any sites
. ; then no sites should be selectable for this route (e.g., Oral)
. I '$D(PXRSLT) S PXRSLT("NONE")=""
;
; If no mapping exists, all entries are selectable
I '$D(^PXV(920.6,PXROUTE)) D
. S PXRSLT("ALL")=""
;
Q
;
IMMDEF(PXRSLT,PXIMM,PXINST) ;
;
N PXIEN,PXPRNT,PXSTA,PXUNITS,PXNUNITS,PXUCUM
;
I '$G(PXIMM)!('$G(PXINST)) Q
I $D(PXINST(PXINST)) Q ; Used to prevent infinite recursion
;
S PXIEN=$O(^PXV(920.05,"AC",PXINST,PXIMM,0))
;
I PXIEN D
. M PXRSLT=^PXV(920.05,PXIEN,1,PXIMM)
;
; If site did not create defaults, make recursive
; call for parent Institution; if parent has defaults,
; inherit from parent.
I 'PXIEN D
. S PXSTA=$$STA^XUAF4(PXINST)
. I PXSTA="" Q
. S PXPRNT=$$PRNT^XUAF4(PXSTA)
. ;
. ; If parent = self, we reached the top of the chain
. I $P(PXPRNT,U,2)=PXSTA Q
. I (+PXPRNT)=PXINST Q
. I 'PXPRNT Q
. ;
. ; Used to prevent infinite recursion
. S PXINST(PXINST)=""
. ;
. S PXINST=+PXPRNT
. D IMMDEF(.PXRSLT,PXIMM,.PXINST)
;
S PXUNITS=$P($G(PXRSLT(13)),U,13)
S PXNUNITS=$P($G(PXRSLT(13)),U,14)
I PXUNITS="",PXNUNITS="" D ; default to mL unless overriden by imm default response
. K PXUCUM
. D UCUMDATA^LEXMUCUM("mL",.PXUCUM)
. S PXUNITS=$O(PXUCUM(0))
. I PXUNITS S $P(PXRSLT(13),U,13)=PXUNITS
;
Q
;
;
HIST(PXRESULTS,PXTYPE,PXIENLST,DFN,PXDIR) ;
;
; Return patient's immunization or skin test history for a given
; list of immunizations or skin tests.
;
; Inputs:
; PXTYPE = "SK": for Skin Tests
; "IM": For Immunizations
; PXIENLST = List of IENs from the Immunization/Skin Test file (passed by reference).
; PXIENLST(IEN)=""
; DFN = Patient (#2) IEN
; PXDIR = Sort order.
; 1: Most recent first
; 0: Oldest first
;
; Returns:
; For Immunizations:
; PXRESULTS(n)=Immunization Name ^ Date Administered ^ Series ^ Facility
; For Skin Tests:
; PXRESULTS(n)=Skin Test Name ^ Date Admin ^ Date Read ^ Reading ^ Result ^ Facility
;
N PXCNT,PXDAS,PXDATE,PXFILE,PXIEN,PXSUB,PXTMP
;
S PXFILE=$S($G(PXTYPE)="SK":9000010.12,1:9000010.11)
;
S PXIEN=0
F S PXIEN=$O(PXIENLST(PXIEN)) Q:'PXIEN D
. S PXDATE=0
. F S PXDATE=$O(^PXRMINDX(PXFILE,"PI",DFN,PXIEN,PXDATE)) Q:'PXDATE D
. . S PXDAS=0
. . F S PXDAS=$O(^PXRMINDX(PXFILE,"PI",DFN,PXIEN,PXDATE,PXDAS)) Q:'PXDAS D
. . . S PXSUB=PXDATE
. . . I $G(PXDIR) S PXSUB=9999999-PXDATE
. . . S PXTMP(PXSUB,PXDAS)=PXDATE
;
S PXCNT=0
S PXSUB=""
F S PXSUB=$O(PXTMP(PXSUB)) Q:PXSUB="" D
. S PXDAS=0
. F S PXDAS=$O(PXTMP(PXSUB,PXDAS)) Q:'PXDAS D
. . S PXDATE=$G(PXTMP(PXSUB,PXDAS))
. . I PXFILE=9000010.11 D ADDIMM(.PXRESULTS,.PXCNT,PXDAS,PXDATE)
. . I PXFILE=9000010.12 D ADDSK(.PXRESULTS,.PXCNT,PXDAS)
;
Q
;
ADDIMM(PXRESULT,PXCNT,PXDAS,PXDATE) ;
N PXIMM,PXFAC,PXVISIT
D VIMM^PXPXRM(PXDAS,.PXIMM)
S PXCNT=PXCNT+1
S PXFAC=$P(PXIMM("FACILITY"),U,2)
I PXFAC="" D
. S PXVISIT=$P($G(^AUPNVIMM(+PXDAS,0)),U,3)
. I 'PXVISIT Q
. S PXFAC=$P($G(^AUPNVSIT(PXVISIT,21)),U,1)
S PXRESULT(PXCNT)=$P(PXIMM("IMMUNIZATION"),U,2)_U_PXDATE_U_PXIMM("SERIES")_U_PXFAC
Q
;
ADDSK(PXRESULT,PXCNT,PXDAS) ;
N PXDATE,PXSK
D VSKIN^PXPXRM(PXDAS,.PXSK)
S PXDATE=$G(PXSK("EVENT DATE AND TIME"))
I 'PXDATE S PXDATE=PXSK("PLACEMENT VISIT DATE TIME")
I 'PXDATE S PXDATE=PXSK("VISIT DATE TIME")
S PXCNT=PXCNT+1
S PXRESULT(PXCNT)=$P(PXSK("SKIN TEST"),U,2)_U_PXDATE_U_PXSK("DATE READ")_U_PXSK("READING")_U_PXSK("RESULTS")_U_$P(PXSK("FACILITY"),U,2)
Q
;
READVALS(PXRESULT) ;return data type for reading fields
N PXCODE,PXCODES,PXI
;
S PXRESULT("RANGE")="0:40:0" ;Minimum:Maximum:Maximum decimals
;
S PXCODES=$$GET1^DID(9000010.11,1401,"","SET OF CODES")
F PXI=1:1 S PXCODE=$P(PXCODES,";",PXI) Q:PXCODE="" D
. S PXRESULT("CODES",PXCODE)=""
;
Q
;
READENT(PXRESULT,DFN) ;
; Find most recent immunization admin for vaccine that requires reading.
; Only return if there is no reading entered previously.
;
N PXDATE,PXIMM,PXNAME,PXTEMP,PXVIMM,PXVIMM14
;
S PXRESULT(1)=""
;
; Get all V Imm entries for immunizations that require reading (currently only Smallpox)
S PXIMM=0
F S PXIMM=$O(^AUTTIMM(PXIMM)) Q:'PXIMM D
. I '$P($G(^AUTTIMM(PXIMM,.5)),U,1) Q
. S PXDATE=$O(^PXRMINDX(9000010.11,"PI",DFN,PXIMM,""),-1)
. I 'PXDATE Q
. S PXVIMM=$O(^PXRMINDX(9000010.11,"PI",DFN,PXIMM,PXDATE,0))
. I 'PXVIMM Q
. S PXTEMP(PXDATE,PXVIMM)=PXIMM
;
; find most recent admin
S PXDATE=$O(PXTEMP(""),-1)
I 'PXDATE Q
S PXVIMM=$O(PXTEMP(PXDATE,0))
I 'PXVIMM Q
;
S PXIMM=PXTEMP(PXDATE,PXVIMM)
S PXVIMM14=$G(^AUPNVIMM(PXVIMM,14))
; if both Reading and Results are populated, quit
I $P(PXVIMM14,U,1)'="",$P(PXVIMM14,U,2)'="" Q
;
S PXNAME=$P($G(^AUTTIMM(PXIMM,0)),U,1)
S PXRESULT(1)=PXVIMM_U_PXNAME_U_PXDATE
;
Q
;
GETLOT(PXRTRN,PXIMM,PXDATE,PXLOC) ;
;
; Get active lots for a given immunization
;
; PXIMM - Immunization IEN or C:CVX Code
; PXDATE - Date (Optional; Defaults to NOW)
; PXLOC - Used to determine Institution (Optional)
; Possible values are:
; "I:X": Institution (#4) IEN #X
; "V:X": Visit (#9000010) IEN #X
; "L:X": Hopital Location (#44) IEN #X
; If PXLOC is not passed in OR could not make determination based off
; input, then default to DUZ(2), and if DUZ(2) is not defined,
; default to Default Institution.
;
;
N PXCNT,PXCVX,PXINST,PXSUB
;
S PXIMM=$G(PXIMM)
I $E(PXIMM,1)="C" D
. S PXCVX=$P(PXIMM,":",2)
. I PXCVX="" Q
. D CVXTOIEN(.PXIMM,PXCVX)
. S PXIMM=$P(PXIMM,U,1)
;
I ('PXIMM)!('$D(^AUTTIMM(+PXIMM,0))) D Q
. S PXRTRN(0)="-1^Immunization entry not found."
;
I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
S PXINST=$$INST^PXVUTIL($G(PXLOC))
;
S PXSUB="PXVIMM"
K ^TMP(PXSUB,$J)
D GETLOT^PXVRPC4(PXSUB,PXIMM,PXDATE,PXINST)
M PXRTRN=^TMP(PXSUB,$J,"LOT")
K ^TMP(PXSUB,$J)
;
S PXCNT=+$O(PXRTRN(""),-1)
S PXRTRN(0)=PXCNT
;
Q
;
CVXTOIEN(PXRSLT,PXCVX) ;
;
; Return an Immunization IEN for a given CVX code.
;
;Input:
; PXCVX - A CVX code
;
;Returns:
; If a match is found:
; PXRSLT=Immunization IEN ^ Name ^ Status (1: Active; 0: Inactive) ^ Selectable for Historic
; Else:
; PXRSLT=""
;
N PXCLASS,PXIMM,PXNAME,PXSELHIST,PXSTATUS
;
S PXRSLT=""
I $G(PXCVX)="" Q
S PXIMM=0
F S PXIMM=$O(^AUTTIMM("C",PXCVX,PXIMM)) Q:'PXIMM D
. S PXCLASS=$P($G(^AUTTIMM(PXIMM,100)),U,1)
. I PXCLASS'="N" Q
. S PXSELHIST=$P($G(^AUTTIMM(PXIMM,6)),U,1)
. I PXSELHIST="Y"!(PXRSLT="") S PXRSLT=PXIMM
;
I PXRSLT D
. S PXNAME=$P($G(^AUTTIMM(PXRSLT,0)),U,1)
. S PXSELHIST=$P($G(^AUTTIMM(PXRSLT,6)),U,1)
. S PXSTATUS='$P($G(^AUTTIMM(PXRSLT,0)),U,7)
. S PXRSLT=PXRSLT_U_PXNAME_U_PXSTATUS_U_PXSELHIST
;
Q
;
;
ISIMMSEL(PXRSLT,PXIMM,PXDATE,PXLOC,PXHIST) ;
;
; Is this immunization selectable for the given encounter?
;
; PXIMM - Immunization IEN or C:CVX Code
; PXDATE - Date (Optional; Defaults to NOW)
; PXLOC - Used to determine Institution (Optional)
; Possible values are:
; "I:X": Institution (#4) IEN #X
; "V:X": Visit (#9000010) IEN #X
; "L:X": Hopital Location (#44) IEN #X
; If PXLOC is not passed in OR could not make determination based off
; input, then default to DUZ(2), and if DUZ(2) is not defined,
; default to Default Institution.
; PXHIST - Is this a historical encounter (1:Yes; 0: No) (Optional; Defaults to No)
;
;Returns:
; PXRSLT= 1:If Immunization is selectable; 0: otherwise
; For non-historical: Immunization must be active and have selectable lots,
; for it to be selectable;
; For historical: As long as immunization is Active or Inactive, but Selectable for Historic,
; it is selectable.
;
N PXCVX,PXLOTS,PXSTATUS
;
S PXRSLT=0
;
I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
I '$G(PXHIST) S PXHIST=0
S PXIMM=$G(PXIMM)
I $E(PXIMM,1)="C" D
. S PXCVX=$P(PXIMM,":",2)
. I PXCVX="" Q
. D CVXTOIEN(.PXIMM,PXCVX)
. S PXIMM=$P(PXIMM,U,1)
;
I ('PXIMM)!('$D(^AUTTIMM(+PXIMM,0))) Q
;
S PXSTATUS=$$IMMSTADT(PXIMM,PXDATE)
;
; If historical, Quit
; Return 1 if imm is active or sel for historical
I PXHIST D Q
. I PXSTATUS?1(1"A",1"H") S PXRSLT=1
;
; for non-historical, return 0 if imm is inactive
I PXSTATUS'="A" Q
;
; return 1, if there are lots; 0 otherwise
D GETLOT(.PXLOTS,PXIMM,PXDATE,$G(PXLOC))
I $O(PXLOTS(0)) S PXRSLT=1
;
Q
;
;
;
IMMSTADT(PXIMM,PXDATE) ;
;
;Returns Immunization status for a given date
;
;Input:
; PXIMM - (required) Pointer to #9999999.14
; PXDATE - Date (Optional; Defaults to NOW)
;
;Returns:
; A: Active
; H: Inactive, but Selectable for Historic
; I: Inactive
;
N PXAUDIT,PXSTATUS
;
I '$G(PXIMM) Q ""
I '$D(^AUTTIMM(PXIMM)) Q ""
;
I '$G(PXDATE) S PXDATE=$$NOW^XLFDT()
S PXAUDIT=0
I $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS" S PXAUDIT=1
S PXSTATUS=$$GETSTAT^PXVRPC4(PXIMM,PXDATE,$$GETCSTAT^PXVRPC4(PXDATE,PXAUDIT),PXAUDIT)
;
I PXSTATUS Q "A"
I $P($G(^AUTTIMM(PXIMM,6)),U,1)="Y" Q "H"
Q "I"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAPIIM 19503 printed Apr 09, 2024@21:32:28 Page 2
PXAPIIM ;ISP/LMT - PCE Immunization APIs ;Aug 16, 2023@14:05
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**210,215,217,236**;Aug 12, 1996;Build 17
+2 ;
+3 ; Reference to NAME in file .85 is supported by ICR #6062
+4 ;
+5 QUIT
+6 ;
VIS(PXRESULT,PXVIS,PXDATE) ;Called from VIS^PXAPI
+1 ;
+2 ;Input:
+3 ; PXRESULT (required) Return value (passed by reference)
+4 ; PXVIS (required) Pointer to #920
+5 ; PXDATE (optional; defaults to NOW) The date in FileMan format.
+6 ; Used to check the status of the VIS on that date.
+7 ;Returns:
+8 ; PXRESULT("NAME") = VIS Name
+9 ; PXRESULT("EDITION DATE") = FileManager Internal Format for date/time
+10 ; PXRESULT("EDITION STATUS") = code^value (C^CURRENT or H^HISTORIC)
+11 ; PXRESULT("LANGUAGE") = IEN ^ Language (e.g., 1^ENGLISH)
+12 ; PXRESULT("2D BAR CODE") = Barcode from the CDC VIS barcode lookup table
+13 ; PXRESULT("VIS URL") = Internet URL for this VIS
+14 ; PXRESULT("STATUS") = Status based on PXDATE (1^ACTIVE or 0^INACTIVE)
+15 ;
+16 NEW PXDATA,PXFILE,PXIENS,PXLANG,PXSTATUS
+17 ;
+18 SET PXFILE=920
+19 SET PXIENS=PXVIS_","
+20 DO GETS^DIQ(PXFILE,PXIENS,"*","EI","PXDATA")
+21 ;
+22 SET PXRESULT("NAME")=$GET(PXDATA(PXFILE,PXIENS,.01,"E"))
+23 SET PXRESULT("EDITION DATE")=$GET(PXDATA(PXFILE,PXIENS,.02,"I"))
+24 SET PXRESULT("EDITION STATUS")=$GET(PXDATA(PXFILE,PXIENS,.03,"I"))_U_$GET(PXDATA(PXFILE,PXIENS,.03,"E"))
+25 SET PXRESULT("2D BAR CODE")=$GET(PXDATA(PXFILE,PXIENS,100,"E"))
+26 SET PXRESULT("VIS URL")=$GET(PXDATA(PXFILE,PXIENS,101,"E"))
+27 ;
+28 SET PXLANG=$GET(PXDATA(PXFILE,PXIENS,.04,"I"))
+29 IF PXLANG
Begin DoDot:1
+30 ;ICR 6062
SET PXLANG=PXLANG_U_$$GET1^DIQ(.85,PXLANG_",","NAME")
End DoDot:1
+31 SET PXRESULT("LANGUAGE")=PXLANG
+32 ;
+33 SET PXSTATUS=$$GETSTAT^XTID(PXFILE,.01,PXIENS,$GET(PXDATE))
+34 SET PXRESULT("STATUS")=$PIECE(PXSTATUS,U,1)_U_$PIECE(PXSTATUS,U,3)
+35 ;
+36 QUIT
+37 ;
IMMGRP(PXRESULT,PXIMM,PXSKIPNOTLIMITED) ;
+1 ;
+2 ; Returns a list of immunizations that share the same CVX code and Vaccine Group
+3 ; Name(s) as PXIMM, as well as Contraindications that are limited to PXIMM.
+4 ;
+5 ;Input:
+6 ; PXRESULT (required) Return value (passed by reference)
+7 ; PXIMM (required) Pointer to #9999999.14
+8 ; PXSKIPNOTLIMITED (optional) Boolean flag to exclude (1) or include (0)
+9 ; contraindications that are not limited to any
+10 ; immunization; default is to include (0)
+11 ;
+12 ;
+13 ;Returns:
+14 ; PXRESULT("CVX",CVX_CODE,IMM_IEN) = Immunization Name
+15 ; PXRESULT("VG",GROUP_NAME,IMM_IEN) = Immunization Name
+16 ; PXRESULT("ICR",CONTRA_VIEN) = Contraindication Name
+17 ;
+18 IF '$GET(PXIMM)
QUIT
+19 DO IMMGRP^PXAPIIM2(.PXRESULT,.PXIMM,.PXSKIPNOTLIMITED)
+20 ;
+21 QUIT
+22 ;
SKSTAT(PXSK) ;
+1 ;
+2 ;Returns Skin Test status
+3 ;
+4 ;Input:
+5 ; PXSK - (required) Pointer to #9999999.14
+6 ;
+7 ;Returns:
+8 ; 1: Active
+9 ; 0: Inactive
+10 ;
+11 IF '$GET(PXSK)
QUIT ""
+12 QUIT $$GETSTAT^PXVRPC8(PXSK,DT,1,0)
+13 ;
IMMSTAT(PXIMM) ;
+1 ;
+2 ;Returns Immunization status
+3 ;
+4 ;Input:
+5 ; PXIMM - (required) Pointer to #9999999.14
+6 ;
+7 ;Returns:
+8 ; A: Active
+9 ; H: Inactive, but Selectable for Historic
+10 ; I: Inactive
+11 ;
+12 IF '$GET(PXIMM)
QUIT ""
+13 IF '$DATA(^AUTTIMM(PXIMM))
QUIT ""
+14 IF $PIECE($GET(^AUTTIMM(PXIMM,0)),U,7)=""
QUIT "A"
+15 IF $PIECE($GET(^AUTTIMM(PXIMM,6)),U,1)="Y"
QUIT "H"
+16 QUIT "I"
+17 ;
IMMNODEF() ; Returns "IMMUNIZATION, NO DEFAULT SELECTED" entry
+1 NEW PXIMM
+2 SET PXIMM=$ORDER(^AUTTIMM("AVUID",5237389,0))
+3 IF 'PXIMM
SET PXIMM=$ORDER(^AUTTIMM("B","IMMUNIZATION, NO DEFAULT SELECTED",0))
+4 QUIT PXIMM
+5 ;
IMMBYNM(PXNAME) ; Finds Immunization that matches on PXNAME and returns IEN
+1 NEW PXIMM
+2 IF $GET(PXNAME)=""
QUIT 0
+3 SET PXIMM=$ORDER(^AUTTIMM("B",PXNAME,0))
+4 IF PXIMM
QUIT PXIMM
+5 SET PXIMM=$ORDER(^AUTTIMM("G",PXNAME,0))
+6 IF PXIMM
QUIT PXIMM
+7 SET PXIMM=$ORDER(^AUTTIMM("H",PXNAME,0))
+8 IF PXIMM
QUIT PXIMM
+9 QUIT 0
+10 ;
PATICR(PXRESULT,DFN,PXIMM,PXBDT,PXEDT,PXSKIPFOUR) ;
+1 ;
+2 ; Finds all of a patient's contraindications/refusals using the following criteria:
+3 ; 1. Any current-dated contraindication/refusal for PXIMM AND any immunization
+4 ; that shares the same CVX code.
+5 ; 2. If the Refused Vaccine Group (#1205) is set to Yes, then include any
+6 ; current-dated refusals for an immunization that shares the same vaccine
+7 ; group as PXIMM.
+8 ; 3. Any current-dated contraindications where the contraindication has PXIMM
+9 ; listed in the "Immunization Limited To" multiple.
+10 ; 4. Any current-dated contraindications where the contraindication does not have
+11 ; anything listed in the "Immunization Limited To" multiple, excluding Severe
+12 ; Reaction Previous Dose.
+13 ;
+14 ; * If PXBDT and PXEDT are null, then "current-dated" means where STOP >= TODAY.
+15 ; * If PXBDT and PXEDT are defined, then "current-dated" means where START
+16 ; <= PXEDT, and STOP is >= PXBDT.
+17 ;
+18 ;Input:
+19 ; PXRESULT - (required) Return value (passed by reference)
+20 ; DFN - (required) Pointer to #2
+21 ; PXIMM - (required) Pointer to #9999999.14
+22 ; PXBDT - (optional; defaults to TODAY) Begin Search Date
+23 ; PXEDT - (optional; defaults to 9999999) End Search Date
+24 ; PXSKIPFOUR - (optional; defaults to 0) Boolean flag to exclude (1) or
+25 ; include (0) criteria #4 above from
+26 ; search; default is include (0)
+27 ;
+28 ;Returns:
+29 ; PXRESULT(DAS) = Visit IEN ^ Contra/Refusal variable pointer | Contra/Refusal Name
+30 ; ^ Immunization IEN | Name ^ Warn Until Date ^ D/T Recorded ^ Event D/T
+31 ; ^ Encounter Provider IEN | Name ^ Refused Vaccine Group (1/0)
+32 ; PXRESULT(DAS,"COMMENTS") = Comments
+33 ; When the entry is from IMM CONTRAINDICATION REASONS this is defined:
+34 ; PXRESULT(DAS,"CONTRAINDICATION/PRECAUTION")=CONTRAINDICATION/PRECAUTION
+35 ;
+36 ; * DAS = Pointer to #9000010.707
+37 ;
+38 NEW PXCVX,PXDAS,PXDATA,PXFILE,PXICR,PXIMMB,PXIMMGRP,PXSEARCH,PXSEARCHBY,PXSUB,PXVGN,PXX
+39 ;
+40 IF '$GET(DFN)!('$GET(PXIMM))
QUIT
+41 ;
+42 SET PXSKIPFOUR=+$GET(PXSKIPFOUR)
+43 SET PXFILE=9000010.707
+44 ;
+45 IF $GET(PXEDT)=""
SET PXEDT=9999999
+46 IF $GET(PXBDT)=""
SET PXBDT=DT
+47 IF PXBDT
SET PXBDT=PXBDT-.0000001
+48 ;
+49 DO IMMGRP(.PXIMMGRP,PXIMM,PXSKIPFOUR)
+50 ;
+51 ; >> Search based off criteria #1 & #2:
+52 ;
+53 ; PXSEARCH("ALL") - assists in searching based off criteria #1
+54 SET PXSEARCH("ALL",PXIMM)=""
+55 SET PXCVX=$ORDER(PXIMMGRP("CVX",""))
+56 IF PXCVX'=""
Begin DoDot:1
+57 SET PXIMMB=0
+58 FOR
SET PXIMMB=$ORDER(PXIMMGRP("CVX",PXCVX,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+59 SET PXSEARCH("ALL",PXIMMB)=""
End DoDot:2
End DoDot:1
+60 ;
+61 ; PXSEARCH("REFUSALS") - assists in searching based off criteria #2
+62 SET PXVGN=""
+63 FOR
SET PXVGN=$ORDER(PXIMMGRP("VG",PXVGN))
if PXVGN=""
QUIT
Begin DoDot:1
+64 SET PXIMMB=0
+65 FOR
SET PXIMMB=$ORDER(PXIMMGRP("VG",PXVGN,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+66 IF '$DATA(PXSEARCH("ALL",PXIMMB))
SET PXSEARCH("REFUSALS",PXIMMB)=""
End DoDot:2
End DoDot:1
+67 ;
+68 FOR PXSEARCHBY="ALL","REFUSALS"
Begin DoDot:1
+69 SET PXIMMB=0
+70 FOR
SET PXIMMB=$ORDER(PXSEARCH(PXSEARCHBY,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+71 SET PXICR=""
+72 FOR
SET PXICR=$ORDER(^PXRMINDX(PXFILE,"PIC",DFN,PXIMMB,PXICR))
if 'PXICR
QUIT
Begin DoDot:3
+73 IF PXSEARCHBY="REFUSALS"
IF PXICR'[920.5
QUIT
+74 SET PXSUB(1)=PXFILE
SET PXSUB(2)="PIC"
SET PXSUB(3)=DFN
SET PXSUB(4)=PXIMMB
SET PXSUB(5)=PXICR
+75 DO SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT,PXSEARCHBY)
End DoDot:3
End DoDot:2
End DoDot:1
+76 ;
+77 ; >> Search based off criteria #3 & #4:
+78 ;
+79 SET PXICR=""
+80 FOR
SET PXICR=$ORDER(PXIMMGRP("ICR",PXICR))
if 'PXICR
QUIT
Begin DoDot:1
+81 SET PXIMMB=0
+82 FOR
SET PXIMMB=$ORDER(^PXRMINDX(PXFILE,"PCI",DFN,PXICR,PXIMMB))
if 'PXIMMB
QUIT
Begin DoDot:2
+83 SET PXSUB(1)=PXFILE
SET PXSUB(2)="PCI"
SET PXSUB(3)=DFN
SET PXSUB(4)=PXICR
SET PXSUB(5)=PXIMMB
+84 DO SEARCH(.PXRESULT,.PXSUB,.PXBDT,.PXEDT)
End DoDot:2
End DoDot:1
+85 ;
+86 ; >> Setup return array fields:
+87 SET PXDAS=0
+88 FOR
SET PXDAS=$ORDER(PXRESULT(PXDAS))
if 'PXDAS
QUIT
Begin DoDot:1
+89 KILL PXDATA
+90 DO VICR^PXPXRM(PXDAS,.PXDATA)
+91 SET PXX=$GET(PXDATA("VISIT"))
+92 SET PXX=PXX_U_$PIECE($GET(PXDATA("CONTRA/REFUSAL")),U,1)_"|"_$PIECE($GET(PXDATA("CONTRA/REFUSAL")),U,2)
+93 SET PXX=PXX_U_$PIECE($GET(PXDATA("IMMUN")),U,1)_"|"_$PIECE($GET(PXDATA("IMMUN")),U,2)
+94 SET PXX=PXX_U_$GET(PXDATA("WARN UNTIL DATE"))
+95 SET PXX=PXX_U_$GET(PXDATA("D/T RECORDED"))
+96 SET PXX=PXX_U_$GET(PXDATA("EVENT D/T"))
+97 SET PXX=PXX_U_$PIECE($GET(PXDATA("ENC PROVIDER")),U,1)_"|"_$PIECE($GET(PXDATA("ENC PROVIDER")),U,2)
+98 SET PXX=PXX_U_$GET(PXDATA("REFUSED VACCINE GROUP"))
+99 SET PXRESULT(PXDAS)=PXX
+100 IF $GET(PXDATA("CONTRAINDICATION/PRECAUTION"))'=""
SET PXRESULT(PXDAS,"CONTRAINDICATION/PRECAUTION")=PXDATA("CONTRAINDICATION/PRECAUTION")
+101 SET PXRESULT(PXDAS,"COMMENTS")=$GET(PXDATA("COMMENTS"))
End DoDot:1
+102 QUIT
+103 ;
SEARCH(PXRESULT,PXSUB,PXBDT,PXEDT,PXSEARCHBY) ; Helper function for PATICR
+1 ;
+2 NEW PXDAS,PXSTART,PXSTOP
+3 ;
+4 SET PXSTART=0
+5 FOR
SET PXSTART=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART))
if 'PXSTART!(PXEDT<PXSTART)
QUIT
Begin DoDot:1
+6 SET PXSTOP=PXBDT
+7 FOR
SET PXSTOP=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP))
if 'PXSTOP
QUIT
Begin DoDot:2
+8 SET PXDAS=0
+9 FOR
SET PXDAS=$ORDER(^PXRMINDX(PXSUB(1),PXSUB(2),PXSUB(3),PXSUB(4),PXSUB(5),PXSTART,PXSTOP,PXDAS))
if 'PXDAS
QUIT
Begin DoDot:3
+10 ; If refusal is only for this vaccine, quit
+11 IF $GET(PXSEARCHBY)="REFUSALS"
IF $PIECE($GET(^AUPNVICR(PXDAS,12)),U,5)=0
QUIT
+12 SET PXRESULT(PXDAS)=""
End DoDot:3
End DoDot:2
End DoDot:1
+13 ;
+14 QUIT
+15 ;
SITES(PXRSLT,PXROUTE,PXSORTBY) ;
+1 ;
+2 ;Returns list of selectable Sites for a given Route
+3 ;
+4 ;Input:
+5 ; PXROUTE - (required) Pointer to #920.2
+6 ; PXSORTBY - (optional; defaults to "N")
+7 ; "N" - Sort by Name
+8 ; "R" - Sort by IEN
+9 ;
+10 ;Returns:
+11 ; - If only a subset of sites are selectable for this route,
+12 ; that list will be returned in PXRSLT.
+13 ; o If PXSORTBY="N" - PXRSLT(Site_Name)=920_3_IEN ^ HL7 Code
+14 ; o If PXSORTBY="R" - PXRSLT(920_3_IEN)=Site_Name ^ HL7 Code
+15 ; - If all sites are selectable for this route, the API will return:
+16 ; PXRSLT("ALL")=""
+17 ; - If no sites are selectable for this route, the API will return:
+18 ; PXRSLT("NONE")=""
+19 ;
+20 NEW PXI,PXSITE,PXSITEHL,PXSITENM
+21 ;
+22 IF '$GET(PXROUTE)
QUIT
+23 IF '$DATA(^PXV(920.2,PXROUTE,0))
QUIT
+24 IF $GET(PXSORTBY)'?1(1"N",1"R")
SET PXSORTBY="N"
+25 ;
+26 IF $DATA(^PXV(920.6,PXROUTE))
Begin DoDot:1
+27 SET PXI=0
+28 FOR
SET PXI=$ORDER(^PXV(920.6,PXROUTE,1,PXI))
if 'PXI
QUIT
Begin DoDot:2
+29 SET PXSITE=$PIECE($GET(^PXV(920.6,PXROUTE,1,PXI,0)),U,1)
+30 SET PXSITENM=$PIECE($GET(^PXV(920.3,+PXSITE,0)),U,1)
+31 SET PXSITEHL=$PIECE($GET(^PXV(920.3,PXSITE,0)),U,2)
+32 IF PXSITENM=""
QUIT
+33 IF PXSORTBY="N"
SET PXRSLT(PXSITENM)=PXSITE_U_PXSITEHL
+34 IF PXSORTBY="R"
SET PXRSLT(PXSITE)=PXSITENM_U_PXSITEHL
End DoDot:2
+35 ;
+36 ; if this route exists in 920.6, but is not mapped to any sites
+37 ; then no sites should be selectable for this route (e.g., Oral)
+38 IF '$DATA(PXRSLT)
SET PXRSLT("NONE")=""
End DoDot:1
+39 ;
+40 ; If no mapping exists, all entries are selectable
+41 IF '$DATA(^PXV(920.6,PXROUTE))
Begin DoDot:1
+42 SET PXRSLT("ALL")=""
End DoDot:1
+43 ;
+44 QUIT
+45 ;
IMMDEF(PXRSLT,PXIMM,PXINST) ;
+1 ;
+2 NEW PXIEN,PXPRNT,PXSTA,PXUNITS,PXNUNITS,PXUCUM
+3 ;
+4 IF '$GET(PXIMM)!('$GET(PXINST))
QUIT
+5 ; Used to prevent infinite recursion
IF $DATA(PXINST(PXINST))
QUIT
+6 ;
+7 SET PXIEN=$ORDER(^PXV(920.05,"AC",PXINST,PXIMM,0))
+8 ;
+9 IF PXIEN
Begin DoDot:1
+10 MERGE PXRSLT=^PXV(920.05,PXIEN,1,PXIMM)
End DoDot:1
+11 ;
+12 ; If site did not create defaults, make recursive
+13 ; call for parent Institution; if parent has defaults,
+14 ; inherit from parent.
+15 IF 'PXIEN
Begin DoDot:1
+16 SET PXSTA=$$STA^XUAF4(PXINST)
+17 IF PXSTA=""
QUIT
+18 SET PXPRNT=$$PRNT^XUAF4(PXSTA)
+19 ;
+20 ; If parent = self, we reached the top of the chain
+21 IF $PIECE(PXPRNT,U,2)=PXSTA
QUIT
+22 IF (+PXPRNT)=PXINST
QUIT
+23 IF 'PXPRNT
QUIT
+24 ;
+25 ; Used to prevent infinite recursion
+26 SET PXINST(PXINST)=""
+27 ;
+28 SET PXINST=+PXPRNT
+29 DO IMMDEF(.PXRSLT,PXIMM,.PXINST)
End DoDot:1
+30 ;
+31 SET PXUNITS=$PIECE($GET(PXRSLT(13)),U,13)
+32 SET PXNUNITS=$PIECE($GET(PXRSLT(13)),U,14)
+33 ; default to mL unless overriden by imm default response
IF PXUNITS=""
IF PXNUNITS=""
Begin DoDot:1
+34 KILL PXUCUM
+35 DO UCUMDATA^LEXMUCUM("mL",.PXUCUM)
+36 SET PXUNITS=$ORDER(PXUCUM(0))
+37 IF PXUNITS
SET $PIECE(PXRSLT(13),U,13)=PXUNITS
End DoDot:1
+38 ;
+39 QUIT
+40 ;
+41 ;
HIST(PXRESULTS,PXTYPE,PXIENLST,DFN,PXDIR) ;
+1 ;
+2 ; Return patient's immunization or skin test history for a given
+3 ; list of immunizations or skin tests.
+4 ;
+5 ; Inputs:
+6 ; PXTYPE = "SK": for Skin Tests
+7 ; "IM": For Immunizations
+8 ; PXIENLST = List of IENs from the Immunization/Skin Test file (passed by reference).
+9 ; PXIENLST(IEN)=""
+10 ; DFN = Patient (#2) IEN
+11 ; PXDIR = Sort order.
+12 ; 1: Most recent first
+13 ; 0: Oldest first
+14 ;
+15 ; Returns:
+16 ; For Immunizations:
+17 ; PXRESULTS(n)=Immunization Name ^ Date Administered ^ Series ^ Facility
+18 ; For Skin Tests:
+19 ; PXRESULTS(n)=Skin Test Name ^ Date Admin ^ Date Read ^ Reading ^ Result ^ Facility
+20 ;
+21 NEW PXCNT,PXDAS,PXDATE,PXFILE,PXIEN,PXSUB,PXTMP
+22 ;
+23 SET PXFILE=$SELECT($GET(PXTYPE)="SK":9000010.12,1:9000010.11)
+24 ;
+25 SET PXIEN=0
+26 FOR
SET PXIEN=$ORDER(PXIENLST(PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+27 SET PXDATE=0
+28 FOR
SET PXDATE=$ORDER(^PXRMINDX(PXFILE,"PI",DFN,PXIEN,PXDATE))
if 'PXDATE
QUIT
Begin DoDot:2
+29 SET PXDAS=0
+30 FOR
SET PXDAS=$ORDER(^PXRMINDX(PXFILE,"PI",DFN,PXIEN,PXDATE,PXDAS))
if 'PXDAS
QUIT
Begin DoDot:3
+31 SET PXSUB=PXDATE
+32 IF $GET(PXDIR)
SET PXSUB=9999999-PXDATE
+33 SET PXTMP(PXSUB,PXDAS)=PXDATE
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 SET PXCNT=0
+36 SET PXSUB=""
+37 FOR
SET PXSUB=$ORDER(PXTMP(PXSUB))
if PXSUB=""
QUIT
Begin DoDot:1
+38 SET PXDAS=0
+39 FOR
SET PXDAS=$ORDER(PXTMP(PXSUB,PXDAS))
if 'PXDAS
QUIT
Begin DoDot:2
+40 SET PXDATE=$GET(PXTMP(PXSUB,PXDAS))
+41 IF PXFILE=9000010.11
DO ADDIMM(.PXRESULTS,.PXCNT,PXDAS,PXDATE)
+42 IF PXFILE=9000010.12
DO ADDSK(.PXRESULTS,.PXCNT,PXDAS)
End DoDot:2
End DoDot:1
+43 ;
+44 QUIT
+45 ;
ADDIMM(PXRESULT,PXCNT,PXDAS,PXDATE) ;
+1 NEW PXIMM,PXFAC,PXVISIT
+2 DO VIMM^PXPXRM(PXDAS,.PXIMM)
+3 SET PXCNT=PXCNT+1
+4 SET PXFAC=$PIECE(PXIMM("FACILITY"),U,2)
+5 IF PXFAC=""
Begin DoDot:1
+6 SET PXVISIT=$PIECE($GET(^AUPNVIMM(+PXDAS,0)),U,3)
+7 IF 'PXVISIT
QUIT
+8 SET PXFAC=$PIECE($GET(^AUPNVSIT(PXVISIT,21)),U,1)
End DoDot:1
+9 SET PXRESULT(PXCNT)=$PIECE(PXIMM("IMMUNIZATION"),U,2)_U_PXDATE_U_PXIMM("SERIES")_U_PXFAC
+10 QUIT
+11 ;
ADDSK(PXRESULT,PXCNT,PXDAS) ;
+1 NEW PXDATE,PXSK
+2 DO VSKIN^PXPXRM(PXDAS,.PXSK)
+3 SET PXDATE=$GET(PXSK("EVENT DATE AND TIME"))
+4 IF 'PXDATE
SET PXDATE=PXSK("PLACEMENT VISIT DATE TIME")
+5 IF 'PXDATE
SET PXDATE=PXSK("VISIT DATE TIME")
+6 SET PXCNT=PXCNT+1
+7 SET PXRESULT(PXCNT)=$PIECE(PXSK("SKIN TEST"),U,2)_U_PXDATE_U_PXSK("DATE READ")_U_PXSK("READING")_U_PXSK("RESULTS")_U_$PIECE(PXSK("FACILITY"),U,2)
+8 QUIT
+9 ;
READVALS(PXRESULT) ;return data type for reading fields
+1 NEW PXCODE,PXCODES,PXI
+2 ;
+3 ;Minimum:Maximum:Maximum decimals
SET PXRESULT("RANGE")="0:40:0"
+4 ;
+5 SET PXCODES=$$GET1^DID(9000010.11,1401,"","SET OF CODES")
+6 FOR PXI=1:1
SET PXCODE=$PIECE(PXCODES,";",PXI)
if PXCODE=""
QUIT
Begin DoDot:1
+7 SET PXRESULT("CODES",PXCODE)=""
End DoDot:1
+8 ;
+9 QUIT
+10 ;
READENT(PXRESULT,DFN) ;
+1 ; Find most recent immunization admin for vaccine that requires reading.
+2 ; Only return if there is no reading entered previously.
+3 ;
+4 NEW PXDATE,PXIMM,PXNAME,PXTEMP,PXVIMM,PXVIMM14
+5 ;
+6 SET PXRESULT(1)=""
+7 ;
+8 ; Get all V Imm entries for immunizations that require reading (currently only Smallpox)
+9 SET PXIMM=0
+10 FOR
SET PXIMM=$ORDER(^AUTTIMM(PXIMM))
if 'PXIMM
QUIT
Begin DoDot:1
+11 IF '$PIECE($GET(^AUTTIMM(PXIMM,.5)),U,1)
QUIT
+12 SET PXDATE=$ORDER(^PXRMINDX(9000010.11,"PI",DFN,PXIMM,""),-1)
+13 IF 'PXDATE
QUIT
+14 SET PXVIMM=$ORDER(^PXRMINDX(9000010.11,"PI",DFN,PXIMM,PXDATE,0))
+15 IF 'PXVIMM
QUIT
+16 SET PXTEMP(PXDATE,PXVIMM)=PXIMM
End DoDot:1
+17 ;
+18 ; find most recent admin
+19 SET PXDATE=$ORDER(PXTEMP(""),-1)
+20 IF 'PXDATE
QUIT
+21 SET PXVIMM=$ORDER(PXTEMP(PXDATE,0))
+22 IF 'PXVIMM
QUIT
+23 ;
+24 SET PXIMM=PXTEMP(PXDATE,PXVIMM)
+25 SET PXVIMM14=$GET(^AUPNVIMM(PXVIMM,14))
+26 ; if both Reading and Results are populated, quit
+27 IF $PIECE(PXVIMM14,U,1)'=""
IF $PIECE(PXVIMM14,U,2)'=""
QUIT
+28 ;
+29 SET PXNAME=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,1)
+30 SET PXRESULT(1)=PXVIMM_U_PXNAME_U_PXDATE
+31 ;
+32 QUIT
+33 ;
GETLOT(PXRTRN,PXIMM,PXDATE,PXLOC) ;
+1 ;
+2 ; Get active lots for a given immunization
+3 ;
+4 ; PXIMM - Immunization IEN or C:CVX Code
+5 ; PXDATE - Date (Optional; Defaults to NOW)
+6 ; PXLOC - Used to determine Institution (Optional)
+7 ; Possible values are:
+8 ; "I:X": Institution (#4) IEN #X
+9 ; "V:X": Visit (#9000010) IEN #X
+10 ; "L:X": Hopital Location (#44) IEN #X
+11 ; If PXLOC is not passed in OR could not make determination based off
+12 ; input, then default to DUZ(2), and if DUZ(2) is not defined,
+13 ; default to Default Institution.
+14 ;
+15 ;
+16 NEW PXCNT,PXCVX,PXINST,PXSUB
+17 ;
+18 SET PXIMM=$GET(PXIMM)
+19 IF $EXTRACT(PXIMM,1)="C"
Begin DoDot:1
+20 SET PXCVX=$PIECE(PXIMM,":",2)
+21 IF PXCVX=""
QUIT
+22 DO CVXTOIEN(.PXIMM,PXCVX)
+23 SET PXIMM=$PIECE(PXIMM,U,1)
End DoDot:1
+24 ;
+25 IF ('PXIMM)!('$DATA(^AUTTIMM(+PXIMM,0)))
Begin DoDot:1
+26 SET PXRTRN(0)="-1^Immunization entry not found."
End DoDot:1
QUIT
+27 ;
+28 IF '$GET(PXDATE)
SET PXDATE=$$NOW^XLFDT()
+29 SET PXINST=$$INST^PXVUTIL($GET(PXLOC))
+30 ;
+31 SET PXSUB="PXVIMM"
+32 KILL ^TMP(PXSUB,$JOB)
+33 DO GETLOT^PXVRPC4(PXSUB,PXIMM,PXDATE,PXINST)
+34 MERGE PXRTRN=^TMP(PXSUB,$JOB,"LOT")
+35 KILL ^TMP(PXSUB,$JOB)
+36 ;
+37 SET PXCNT=+$ORDER(PXRTRN(""),-1)
+38 SET PXRTRN(0)=PXCNT
+39 ;
+40 QUIT
+41 ;
CVXTOIEN(PXRSLT,PXCVX) ;
+1 ;
+2 ; Return an Immunization IEN for a given CVX code.
+3 ;
+4 ;Input:
+5 ; PXCVX - A CVX code
+6 ;
+7 ;Returns:
+8 ; If a match is found:
+9 ; PXRSLT=Immunization IEN ^ Name ^ Status (1: Active; 0: Inactive) ^ Selectable for Historic
+10 ; Else:
+11 ; PXRSLT=""
+12 ;
+13 NEW PXCLASS,PXIMM,PXNAME,PXSELHIST,PXSTATUS
+14 ;
+15 SET PXRSLT=""
+16 IF $GET(PXCVX)=""
QUIT
+17 SET PXIMM=0
+18 FOR
SET PXIMM=$ORDER(^AUTTIMM("C",PXCVX,PXIMM))
if 'PXIMM
QUIT
Begin DoDot:1
+19 SET PXCLASS=$PIECE($GET(^AUTTIMM(PXIMM,100)),U,1)
+20 IF PXCLASS'="N"
QUIT
+21 SET PXSELHIST=$PIECE($GET(^AUTTIMM(PXIMM,6)),U,1)
+22 IF PXSELHIST="Y"!(PXRSLT="")
SET PXRSLT=PXIMM
End DoDot:1
+23 ;
+24 IF PXRSLT
Begin DoDot:1
+25 SET PXNAME=$PIECE($GET(^AUTTIMM(PXRSLT,0)),U,1)
+26 SET PXSELHIST=$PIECE($GET(^AUTTIMM(PXRSLT,6)),U,1)
+27 SET PXSTATUS='$PIECE($GET(^AUTTIMM(PXRSLT,0)),U,7)
+28 SET PXRSLT=PXRSLT_U_PXNAME_U_PXSTATUS_U_PXSELHIST
End DoDot:1
+29 ;
+30 QUIT
+31 ;
+32 ;
ISIMMSEL(PXRSLT,PXIMM,PXDATE,PXLOC,PXHIST) ;
+1 ;
+2 ; Is this immunization selectable for the given encounter?
+3 ;
+4 ; PXIMM - Immunization IEN or C:CVX Code
+5 ; PXDATE - Date (Optional; Defaults to NOW)
+6 ; PXLOC - Used to determine Institution (Optional)
+7 ; Possible values are:
+8 ; "I:X": Institution (#4) IEN #X
+9 ; "V:X": Visit (#9000010) IEN #X
+10 ; "L:X": Hopital Location (#44) IEN #X
+11 ; If PXLOC is not passed in OR could not make determination based off
+12 ; input, then default to DUZ(2), and if DUZ(2) is not defined,
+13 ; default to Default Institution.
+14 ; PXHIST - Is this a historical encounter (1:Yes; 0: No) (Optional; Defaults to No)
+15 ;
+16 ;Returns:
+17 ; PXRSLT= 1:If Immunization is selectable; 0: otherwise
+18 ; For non-historical: Immunization must be active and have selectable lots,
+19 ; for it to be selectable;
+20 ; For historical: As long as immunization is Active or Inactive, but Selectable for Historic,
+21 ; it is selectable.
+22 ;
+23 NEW PXCVX,PXLOTS,PXSTATUS
+24 ;
+25 SET PXRSLT=0
+26 ;
+27 IF '$GET(PXDATE)
SET PXDATE=$$NOW^XLFDT()
+28 IF '$GET(PXHIST)
SET PXHIST=0
+29 SET PXIMM=$GET(PXIMM)
+30 IF $EXTRACT(PXIMM,1)="C"
Begin DoDot:1
+31 SET PXCVX=$PIECE(PXIMM,":",2)
+32 IF PXCVX=""
QUIT
+33 DO CVXTOIEN(.PXIMM,PXCVX)
+34 SET PXIMM=$PIECE(PXIMM,U,1)
End DoDot:1
+35 ;
+36 IF ('PXIMM)!('$DATA(^AUTTIMM(+PXIMM,0)))
QUIT
+37 ;
+38 SET PXSTATUS=$$IMMSTADT(PXIMM,PXDATE)
+39 ;
+40 ; If historical, Quit
+41 ; Return 1 if imm is active or sel for historical
+42 IF PXHIST
Begin DoDot:1
+43 IF PXSTATUS?1(1"A",1"H")
SET PXRSLT=1
End DoDot:1
QUIT
+44 ;
+45 ; for non-historical, return 0 if imm is inactive
+46 IF PXSTATUS'="A"
QUIT
+47 ;
+48 ; return 1, if there are lots; 0 otherwise
+49 DO GETLOT(.PXLOTS,PXIMM,PXDATE,$GET(PXLOC))
+50 IF $ORDER(PXLOTS(0))
SET PXRSLT=1
+51 ;
+52 QUIT
+53 ;
+54 ;
+55 ;
IMMSTADT(PXIMM,PXDATE) ;
+1 ;
+2 ;Returns Immunization status for a given date
+3 ;
+4 ;Input:
+5 ; PXIMM - (required) Pointer to #9999999.14
+6 ; PXDATE - Date (Optional; Defaults to NOW)
+7 ;
+8 ;Returns:
+9 ; A: Active
+10 ; H: Inactive, but Selectable for Historic
+11 ; I: Inactive
+12 ;
+13 NEW PXAUDIT,PXSTATUS
+14 ;
+15 IF '$GET(PXIMM)
QUIT ""
+16 IF '$DATA(^AUTTIMM(PXIMM))
QUIT ""
+17 ;
+18 IF '$GET(PXDATE)
SET PXDATE=$$NOW^XLFDT()
+19 SET PXAUDIT=0
+20 IF $$GET1^DID(9999999.14,.07,"","AUDIT")="YES, ALWAYS"
SET PXAUDIT=1
+21 SET PXSTATUS=$$GETSTAT^PXVRPC4(PXIMM,PXDATE,$$GETCSTAT^PXVRPC4(PXDATE,PXAUDIT),PXAUDIT)
+22 ;
+23 IF PXSTATUS
QUIT "A"
+24 IF $PIECE($GET(^AUTTIMM(PXIMM,6)),U,1)="Y"
QUIT "H"
+25 QUIT "I"
+26 ;
