PXRHS03 ;SLC/SBW - PCE Visit data immunization extract ;Sep 08, 2023@13:07
;;1.0;PCE PATIENT CARE ENCOUNTER;**13,210,216,217,236**;Aug 12, 1996;Build 17
IMMUN(DFN,PXFG,PXFILTER) ;Administered immunizations
;INPUT : DFN - Pointer to PATIENT file (#2)
; : PXFG - Primary sort order
; "S": (Default) Alphabetical by Immunization Short Name,
; or Name (if Short Name is null)
; (Since Short Name is not standardized and is null
; for newer immunization (post PX*1*201), the "S"
; argument has been deprecated, and is only supported
; for backward compatibility purposes).
; "A": Alphabetical by Immunization Name
; "C": Chronological
; "R": Reverse Chronological
;
; : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
; "G:XXX": Only include immunizations for Vaccine Group Name XXX
; "I:XXX": Only include immunizations for Immunization IEN XXX
; "C:XXX": Only include immunizations for CVX code XXX
;
;OUTPUT :
; Data from V Immunization (9000010.11) file
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,0) = IMMUNIZATION [E;.01]
; ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]
; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
; ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]
; ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]
; ^ ENCOUNTER PROVIDER [E;1204] ^ ORDERED BY POLICY [I;1222]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
; ^ HOSP. LOC. ABBREVIATION [E;44;1]
; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,2) = ROUTE OF ADMIN [E;1302]
; ^ SITE OF ADMIN [E;1303] ^ DOSAGE [E;1312.5] ^ DOCUMENTER [E;1206]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,3) = LOT [E;.05] ^ MANUF [E;9999999.41;.02]
; ^ EXP DATE [I;9999999.41;.09]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,4)= RESULTS [E;1401] ^ READING [E;1402]
; ^ DATE/TIME READ [I;1403] ^ READER [E;1404] ^ READING RECORDED [I;1405]
; ^ HOURS READ [E;1406]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"RCOM")= READING COMMENT [E;1501]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"R",CNT) = REMARKS [E;1101]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"S") = DATA SOURCE [E;80102]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"COM") = COMMENTS [E;81101]
; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"VIS") = VIS OFFERED TO PATIENT [E;2]
; ^ EDITION DATE [I;920;.02]
;
; [] = [I(nternal)/E(xternal); Optional file #; Record #]
; Subscripts:
; If PXFG
; Equals: Then subscript will be:
; ======= ===========================
; PXSORT - S Immunization short name,
; or Name truncated to 10 characters (if short name is null)
; A Immunization Name
; C Fileman date of DATE OF event or visit
; R Inverse Fileman date of DATE OF event or visit
; PXSORT2 - C or R Immunization name
; - A or S Inverse Fileman date of DATE OF event or visit
;
; IFN - Internal Record #
;
Q:$G(DFN)']""!'$D(^AUPNVIMM("AA",DFN))
N PXIMM,PXIVD,PXIFN,IHSDATE
N PXVLST,PXSORT,PXSORT2,PXVCNT,GMTSMX
K ^TMP("PXI",$J)
D SETUP(.GMTSMX,.IHSDATE,.PXVLST,1)
S PXIMM=""
F S PXIMM=$O(^AUPNVIMM("AA",DFN,PXIMM)) Q:PXIMM="" D
. I $D(PXVLST),'$D(PXVLST(PXIMM)) Q
. S PXIVD=0
. F S PXIVD=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD)) Q:PXIVD'>0 Q:PXIVD>IHSDATE D
. . S PXIFN=0
. . F S PXIFN=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN)) Q:PXIFN'>0 D
. . . N DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT
. . . N OPROV,EPROV,SOURCE,VDATA,IDT,COMMENT
. . . N PXVROUTE,PXVBODY,PXVDOSE,PXVARRAY,PXVC,PXVDATA,PXVDOCBY
. . . N PXVRSLT,PXVRDNG,PXVDTRD,PXVRDR,PXVDTRCRD,PXVHRS,PXVRCMNT,PXVIMIEN
. . . N PXVSTOP,PXVCVX,PXVBYPOL
. . . S DIC=9000010.11,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
. . . S DR=".01;.03;.04;.06;.07;1201;1202;1204;1206;1207;1222;80102;81101;1302;1303;1312.5"
. . . S DR=DR_";1401;1402;1403;1404;1405;1406;1501"
. . . D EN^DIQ1
. . . I '$D(REC) Q
. . . S PXVDATA=$S('+REC(9000010.11,DA,1207,"I"):"",1:$$GETMDATA(+REC(9000010.11,DA,1207,"I"))) ;manuf,lot #,exp dt
. . . S VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))
. . . K PXVARRAY D GETVIS(DA,.PXVARRAY)
. . . S PXVIMIEN=REC(9000010.11,DA,.01,"I")
. . . S SNIMM=$P($G(^AUTTIMM(PXVIMIEN,0)),U,2)
. . . S IMM=REC(9000010.11,DA,.01,"E")
. . . I PXFG="S" D
. . . . S IMM=$E(IMM,1,10)
. . . . I SNIMM']"" S SNIMM=IMM
. . . S PXVCVX=$P($G(^AUTTIMM(PXVIMIEN,0)),U,3)
. . . S IMDT=REC(9000010.11,DA,1201,"I")
. . . S:IMDT']"" IMDT=$P(VDATA,U)
. . . ; Screen entry based off PXFILTER criteria.
. . . S PXVSTOP=$$SCREEN($G(PXFILTER),PXVIMIEN,PXVCVX,.PXVCNT,IMDT) Q:PXVSTOP
. . . D GETSORT(PXFG,IMDT,IMM,SNIMM,.PXSORT,.PXSORT2)
. . . S SERIESC=REC(9000010.11,DA,.04,"I")
. . . S SERIES=REC(9000010.11,DA,.04,"E")
. . . S REACT=REC(9000010.11,DA,.06,"E")
. . . S CONT=REC(9000010.11,DA,.07,"I")
. . . S OPROV=REC(9000010.11,DA,1202,"E")
. . . S EPROV=REC(9000010.11,DA,1204,"E")
. . . S PXVDOCBY=REC(9000010.11,DA,1206,"E") ;documenter
. . . S PXVBYPOL=REC(9000010.11,DA,1222,"I") ;ordered by policy
. . . I +REC(9000010.11,DA,1302,"I") S PXVROUTE=REC(9000010.11,DA,1302,"E") ;admin route
. . . S PXVBODY=REC(9000010.11,DA,1303,"E") ;admin site
. . . S PXVDOSE=REC(9000010.11,DA,1312.5,"E") ;dose
. . . S PXVRSLT=REC(9000010.11,DA,1401,"E") ;results
. . . S PXVRDNG=REC(9000010.11,DA,1402,"E") ;reading
. . . S PXVDTRD=REC(9000010.11,DA,1403,"I") ;date/time read
. . . S PXVRDR=REC(9000010.11,DA,1404,"E") ;reader
. . . S PXVDTRCRD=REC(9000010.11,DA,1405,"I") ;reading recorded
. . . S PXVHRS=REC(9000010.11,DA,1406,"E") ;hours reaad post-inoculation
. . . S PXVRCMNT=REC(9000010.11,DA,1501,"E") ;reading comment
. . . S SOURCE=REC(9000010.11,DA,80102,"E")
. . . S COMMENT=REC(9000010.11,DA,81101,"E")
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,0)=IMM_U_SNIMM_U_IMDT_U_SERIESC_U_SERIES_U_REACT_U_CONT_U_OPROV_U_EPROV_U_PXVBYPOL
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,1)=$$GETENCLOC(VDATA)
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,2)=$G(PXVROUTE)_U_PXVBODY_U_PXVDOSE_U_PXVDOCBY ;new
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,3)=PXVDATA ;new
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,4)=PXVRSLT_U_PXVRDNG_U_PXVDTRD_U_PXVRDR_U_PXVDTRCRD_U_PXVHRS ;new
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"RCOM")=PXVRCMNT ;new
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"S")=SOURCE
. . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"COM")=COMMENT
. . . M ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"VIS")=PXVARRAY(920) ;new VIS array
. . . D PUTIMMNAME(PXIMM,$NA(^TMP("PXI",$J,PXSORT,PXSORT2,DA,"FN")))
. . . D GETREM(PXSORT,PXSORT2,DA) ;in original not used
Q
SETUP(GMTSMX,IHSDATE,PXVLST,PXOLD,PXNOINV) ;Prepare for data extract
N PXVIEN
S GMTSMX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999),PXNOINV=+$G(PXNOINV)
I PXNOINV S IHSDATE=$$HSDATE^PXRHS01
E S IHSDATE=9999999-$$HSDATE^PXRHS01
; if selected records are requested, get IENs and store in a list
I $G(GMTSEGN),$D(GMTSEG(GMTSEGN,9999999.14)) S PXVIEN=0 F S PXVIEN=$O(GMTSEG(GMTSEGN,9999999.14,PXVIEN)) Q:PXVIEN="" D
. S PXVLST(GMTSEG(GMTSEGN,9999999.14,PXVIEN))=""
I $G(PXFG)="" S PXFG=$S(PXOLD:"S",1:"A")
Q
SCREEN(PXFILTER,PXVIMIEN,PXVCVX,PXVCNT,PXIMDT) ;Filter entry based on criteria
N PXVFLTRTYP,PXVFLTRVAL,PXVSTOP,PXVABRV,PXVG
S PXVSTOP=0
;Check filter criteria
I $G(PXFILTER)'="" D Q:PXVSTOP PXVSTOP
.S PXVFLTRTYP=$P(PXFILTER,":",1),PXVFLTRVAL=$P(PXFILTER,":",2)
.I (PXVFLTRTYP="")!(PXVFLTRVAL="") Q
.I PXVFLTRTYP="G",'$D(^AUTTIMM(PXVIMIEN,7,"B",PXVFLTRVAL)) S PXVSTOP=1
.I PXVFLTRTYP="I",PXVFLTRVAL'=PXVIMIEN S PXVSTOP=1
.I PXVFLTRTYP="C",PXVFLTRVAL'=PXVCVX S PXVSTOP=1
;Check time and occurence limits for non-IM health summary components
S PXVCNT(PXIMM)=1+$G(PXVCNT(PXIMM)),PXVABRV=""
I $G(GMTSE) D GETS^DIQ(142.1,GMTSE,"3","","PXVG") S PXVABRV=PXVG(142.1,GMTSE_",",3)
I PXVABRV'="IM",$G(GMTSBEG) I (PXIMDT\1)<(GMTSBEG\1)!(PXVCNT(PXIMM)>GMTSMX) S PXVSTOP=1
Q PXVSTOP
GETSORT(PXFG,PXIMDT,PXIMMEXT,PXSNIMM,PXSORT,PXSORT2) ;RETURN THE SORTING SUBSCRIPTS FOR ^TMP
N PXIDT
;Set date as chronological or reverse chronological
S PXIDT=$S(PXFG="C":PXIMDT,PXFG="S":9999999-PXIMDT,1:9999999-(PXIMDT\1))
;Primary sort subscript
S PXSORT=$S(PXFG="A":PXIMMEXT,PXFG="S":PXSNIMM,1:PXIDT\1)
;Secondary sort subscript
S PXSORT2=$S(PXFG="A":PXIDT\1,PXFG="S":PXIDT,1:PXIMMEXT)
Q
GETENCLOC(PXVDATA) ;Get encounter location data for extract
Q $P(PXVDATA,U,5)_U_$P(PXVDATA,U,6)_U_$P(PXVDATA,U,2)_U_$P(PXVDATA,U,4)
GETREM(PXSORT,PXSORT2,RNUM) ;Get the remark data
N CNT
S CNT=0
F S CNT=$O(^AUPNVIMM(RNUM,11,CNT)) Q:CNT'>0 D
. S ^TMP("PXI",$J,PXSORT,PXSORT2,RNUM,"R",CNT)=$G(^AUPNVIMM(RNUM,11,CNT,0))
Q
GETVDATA(DA) ;Get location of encounter and outside location from visit file
N DIC,DIQ,DR,VREC,HLOC,HLOCABB
S DIC=9000010,DIQ="VREC(",DIQ(0)="IE"
S DR=".01;.06;.07;.22;2101"
D EN^DIQ1
S HLOC=VREC(9000010,DA,.22,"E")
S HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))
Q VREC(9000010,DA,.01,"I")_U_VREC(9000010,DA,.06,"E")_U_VREC(9000010,DA,.07,"I")_U_VREC(9000010,DA,2101,"E")_U_HLOC_U_HLOCABB
GETMDATA(DA) ;Get Manufacturer, lot number and expiration date
; Input DA ien of IMMUNIZATION LOT
; Output MREC LOT NUMBER^MANUFACTURER^EXPIRATION DATE
N DIC,DR,MREC,DIQ
I '$D(^AUTTIML(+$G(DA))) Q ""
S DIQ="MREC",DIQ(0)="IE"
S DIC=9999999.41,DR=".01;.02;.09"
D EN^DIQ1
Q MREC(9999999.41,DA,.01,"E")_U_MREC(9999999.41,DA,.02,"E")_U_MREC(9999999.41,DA,.09,"I")
PUTIMMNAME(PXIMMIFN,PXGLOBAL) ;Put full immunization name into output global
N PXVC
S PXVC=0 F S PXVC=$O(^AUTTIMM(PXIMMIFN,2,PXVC)) Q:PXVC'>0 D
.S @PXGLOBAL@(PXVC)=$G(^AUTTIMM(PXIMMIFN,2,PXVC,0))
Q
GETVIS(PXVI,PXVARRAY) ;Get multiple VIS with edition date
; Input PXVI ien of IMMUNIZATION record
; Output PXVARRAY array of VIS names ^ edition dates
N DIC,DR,PXVIEN,DA,DIQ,SREC
S PXVIEN="",DIQ="SREC",DIQ(0)="IE"
F S PXVIEN=$O(^AUPNVIMM(PXVI,2,"B",PXVIEN)) Q:PXVIEN="" D
. S DIC=920,DR=".01;.02",DA=+PXVIEN
. I '$D(^AUTTIVIS(DA)) Q
. D EN^DIQ1
. S PXVARRAY(920,PXVIEN)=SREC(920,PXVIEN,.01,"E")_U_SREC(920,PXVIEN,.02,"I")
Q
CONREF(DFN,PXFG,PXFILTER) ;Contraindicated and refused immunizations
;INPUT : DFN - Pointer to PATIENT file (#2)
; : PXFG - Primary sort order
; "A": (Default) Alphabetical by Immunization Name
; "C": Chronological
; "R": Reverse Chronological
;
; : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
; "G:XXX": Only include immunizations for Vaccine Group Name XXX
; "I:XXX": Only include immunizations for Immunization IEN XXX
; "C:XXX": Only include immunizations for CVX code XXX
;
;OUTPUT :
; Data from V IMM CONTRA/REFUSAL EVENTS file (#9000010.707)
; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,0) = IMMUNIZATION [E;.04] ^
; EVENT DATE/TIME [I;1201] or VISIT/ADMIT DATE&TIME [I;.03] ^
; TYPE [VARIABLE POINTER PREFIX;.01] ^ CONTRAINDICATION/REFUSAL [E;.01] ^
; WARN UNTIL DATE [I;.05] ^ REFUSED VACCINE GROUP [E;1205] ^
; ENCOUNTER PROVIDER [E;1204] ^ CONTRAINDICATION/PRECAUTION [E;920.4;.06]
; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,1) = HOSPITAL LOCATION [E;9000010;.22] ^
; HOSP. LOC. ABBREVIATION [E;44;1] ^ LOC OF ENCOUNTER [E;9000010;.06] ^
; OUTSIDE LOC [E;9000010;2101]
; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"COM") = COMMENTS [E;81101]
; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"RGROUP",GNAME,IMMIEN) = IMMUNIZATION [E;.04]
; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
;
; [] = [I(nternal)/E(xternal); Optional file #; Field #]
; Subscripts:
; If PXFG
; Equals: Then subscript will be:
; ======= ===========================
; PXSORT - A Immunization Name
; C Fileman date of DATE OF event or visit
; R Inverse Fileman date of DATE OF event or visit
; PXSORT2 - C or R Immunization name
; A Inverse Fileman date of DATE OF event or visit
; PXSORT3 - A, C, R Type; C for Contraindication or R for Refusal
;
; IFN - Internal Record #
Q:+$G(DFN)<1!('$D(^AUPNVICR("AB",DFN)))
N GMTSMX,PXHSDATE,PXVLST,PXIMM,PXVD,PXIFN,PXVCVX,PXVDATA,PXEVENTDT,PXN0
N PXERROR,PXVSTOP,PXVCNT,PXSORT,PXSORT2,PXEVENT,PXFILE,PXTYPE,PXCOPR,PXCIIFN
N PXRETURN,PXENTRIES
K ^TMP("PXCRI",$J)
D SETUP(.GMTSMX,.PXHSDATE,.PXVLST,0,1)
S PXIMM=0 F S PXIMM=$O(^AUPNVICR("AB",DFN,PXIMM)) Q:'+PXIMM D
.I $D(PXVLST),'$D(PXVLST(PXIMM)) Q
.S PXVD=":" F S PXVD=$O(^AUPNVICR("AB",DFN,PXIMM,PXVD),-1) Q:'+PXVD Q:PXVD<PXHSDATE D
..S PXIFN=0 F S PXIFN=$O(^AUPNVICR("AB",DFN,PXIMM,PXVD,PXIFN)) Q:'+PXIFN D
...I '$D(^AUPNVICR(PXIFN,0)) Q
...S PXENTRIES(PXIFN)=""
S PXIMM=0 F S PXIMM=$O(PXVLST(PXIMM)) Q:'+PXIMM D
.D PATICR^PXAPIIM(.PXRETURN,DFN,PXIMM,1600101,,1)
.S PXIFN=0 F S PXIFN=$O(PXRETURN(PXIFN)) Q:'+PXIFN D
..I '$D(PXENTRIES(PXIFN)) S PXENTRIES(PXIFN)=""
S PXIFN=0 F S PXIFN=$O(PXENTRIES(PXIFN)) Q:'+PXIFN D
.S PXIMM=$P($G(^AUPNVICR(PXIFN,0)),U,4)
.N PXERROR,PXRESULT,PXDATA
.S PXVCVX=$P($G(^AUTTIMM(PXIMM,0)),U,3)
.S PXVDATA=$$GETVDATA($P($G(^AUPNVICR(PXIFN,0)),U,3))
.S PXEVENTDT=$P($G(^AUPNVICR(PXIFN,12)),U,1)
.I PXEVENTDT="" S PXEVENTDT=$P(PXVDATA,U,1)
.S PXVSTOP=$$SCREEN($G(PXFILTER),PXIMM,PXVCVX,.PXVCNT,PXEVENTDT) Q:PXVSTOP
.D GETS^DIQ(9000010.707,PXIFN_",",".01;.04;1204;1205;81101","","PXDATA","PXERROR")
.I $D(PXERROR) Q
.D GETSORT(PXFG,PXEVENTDT,PXDATA(9000010.707,PXIFN_",",.04),"",.PXSORT,.PXSORT2)
.S PXEVENT=$P($G(^AUPNVICR(PXIFN,0)),U,1)
.D FILE^DID(+$P(PXEVENT,"(",2),"","NAME","PXFILE","PXERROR")
.I $D(PXERROR) Q
.S PXTYPE=$E($P(PXFILE("NAME")," ",2),1)
.I PXTYPE="C" D
..N PXCDATA
..D GETS^DIQ(920.4,$P(PXEVENT,";",1)_",",".06;3*","","PXCDATA","PXERROR")
..I $D(PXERROR) Q
..S PXCOPR=PXCDATA(920.4,$P(PXEVENT,";",1)_",",.06)
..S PXCIIFN="" F S PXCIIFN=$O(PXCDATA(920.43,PXCIIFN)) Q:PXCIIFN="" D
...S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"LIMITED",+PXCIIFN)=PXCDATA(920.43,PXCIIFN,.01)
.I PXTYPE="R",PXDATA(9000010.707,PXIFN_",",1205)="YES" D
..D IMMGRP^PXAPIIM(.PXRESULT,PXIMM)
..M ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"RGROUP")=PXRESULT("VG")
.S PXEVENT=PXDATA(9000010.707,PXIFN_",",.01)
.S PXN0=PXDATA(9000010.707,PXIFN_",",.04)_U_PXEVENTDT_U_PXTYPE_U_PXEVENT_U
.S PXN0=PXN0_$P($G(^AUPNVICR(PXIFN,0)),U,5)_U
.S PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1205)_U
.S PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1204)_U_$G(PXCOPR)
.S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,0)=PXN0
.S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,1)=$$GETENCLOC(PXVDATA)
.S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"COM")=PXDATA(9000010.707,PXIFN_",",81101)
.D PUTIMMNAME(PXIMM,$NA(^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"FN")))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRHS03 15727 printed Oct 16, 2024@18:31:01 Page 2
PXRHS03 ;SLC/SBW - PCE Visit data immunization extract ;Sep 08, 2023@13:07
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**13,210,216,217,236**;Aug 12, 1996;Build 17
IMMUN(DFN,PXFG,PXFILTER) ;Administered immunizations
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; : PXFG - Primary sort order
+3 ; "S": (Default) Alphabetical by Immunization Short Name,
+4 ; or Name (if Short Name is null)
+5 ; (Since Short Name is not standardized and is null
+6 ; for newer immunization (post PX*1*201), the "S"
+7 ; argument has been deprecated, and is only supported
+8 ; for backward compatibility purposes).
+9 ; "A": Alphabetical by Immunization Name
+10 ; "C": Chronological
+11 ; "R": Reverse Chronological
+12 ;
+13 ; : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
+14 ; "G:XXX": Only include immunizations for Vaccine Group Name XXX
+15 ; "I:XXX": Only include immunizations for Immunization IEN XXX
+16 ; "C:XXX": Only include immunizations for CVX code XXX
+17 ;
+18 ;OUTPUT :
+19 ; Data from V Immunization (9000010.11) file
+20 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,0) = IMMUNIZATION [E;.01]
+21 ; ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]
+22 ; ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
+23 ; ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]
+24 ; ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]
+25 ; ^ ENCOUNTER PROVIDER [E;1204] ^ ORDERED BY POLICY [I;1222]
+26 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
+27 ; ^ HOSP. LOC. ABBREVIATION [E;44;1]
+28 ; ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
+29 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,2) = ROUTE OF ADMIN [E;1302]
+30 ; ^ SITE OF ADMIN [E;1303] ^ DOSAGE [E;1312.5] ^ DOCUMENTER [E;1206]
+31 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,3) = LOT [E;.05] ^ MANUF [E;9999999.41;.02]
+32 ; ^ EXP DATE [I;9999999.41;.09]
+33 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,4)= RESULTS [E;1401] ^ READING [E;1402]
+34 ; ^ DATE/TIME READ [I;1403] ^ READER [E;1404] ^ READING RECORDED [I;1405]
+35 ; ^ HOURS READ [E;1406]
+36 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"RCOM")= READING COMMENT [E;1501]
+37 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
+38 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"R",CNT) = REMARKS [E;1101]
+39 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"S") = DATA SOURCE [E;80102]
+40 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"COM") = COMMENTS [E;81101]
+41 ; ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"VIS") = VIS OFFERED TO PATIENT [E;2]
+42 ; ^ EDITION DATE [I;920;.02]
+43 ;
+44 ; [] = [I(nternal)/E(xternal); Optional file #; Record #]
+45 ; Subscripts:
+46 ; If PXFG
+47 ; Equals: Then subscript will be:
+48 ; ======= ===========================
+49 ; PXSORT - S Immunization short name,
+50 ; or Name truncated to 10 characters (if short name is null)
+51 ; A Immunization Name
+52 ; C Fileman date of DATE OF event or visit
+53 ; R Inverse Fileman date of DATE OF event or visit
+54 ; PXSORT2 - C or R Immunization name
+55 ; - A or S Inverse Fileman date of DATE OF event or visit
+56 ;
+57 ; IFN - Internal Record #
+58 ;
+59 if $GET(DFN)']""!'$DATA(^AUPNVIMM("AA",DFN))
QUIT
+60 NEW PXIMM,PXIVD,PXIFN,IHSDATE
+61 NEW PXVLST,PXSORT,PXSORT2,PXVCNT,GMTSMX
+62 KILL ^TMP("PXI",$JOB)
+63 DO SETUP(.GMTSMX,.IHSDATE,.PXVLST,1)
+64 SET PXIMM=""
+65 FOR
SET PXIMM=$ORDER(^AUPNVIMM("AA",DFN,PXIMM))
if PXIMM=""
QUIT
Begin DoDot:1
+66 IF $DATA(PXVLST)
IF '$DATA(PXVLST(PXIMM))
QUIT
+67 SET PXIVD=0
+68 FOR
SET PXIVD=$ORDER(^AUPNVIMM("AA",DFN,PXIMM,PXIVD))
if PXIVD'>0
QUIT
if PXIVD>IHSDATE
QUIT
Begin DoDot:2
+69 SET PXIFN=0
+70 FOR
SET PXIFN=$ORDER(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN))
if PXIFN'>0
QUIT
Begin DoDot:3
+71 NEW DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT
+72 NEW OPROV,EPROV,SOURCE,VDATA,IDT,COMMENT
+73 NEW PXVROUTE,PXVBODY,PXVDOSE,PXVARRAY,PXVC,PXVDATA,PXVDOCBY
+74 NEW PXVRSLT,PXVRDNG,PXVDTRD,PXVRDR,PXVDTRCRD,PXVHRS,PXVRCMNT,PXVIMIEN
+75 NEW PXVSTOP,PXVCVX,PXVBYPOL
+76 SET DIC=9000010.11
SET DA=PXIFN
SET DIQ="REC("
SET DIQ(0)="IE"
+77 SET DR=".01;.03;.04;.06;.07;1201;1202;1204;1206;1207;1222;80102;81101;1302;1303;1312.5"
+78 SET DR=DR_";1401;1402;1403;1404;1405;1406;1501"
+79 DO EN^DIQ1
+80 IF '$DATA(REC)
QUIT
+81 ;manuf,lot #,exp dt
SET PXVDATA=$SELECT('+REC(9000010.11,DA,1207,"I"):"",1:$$GETMDATA(+REC(9000010.11,DA,1207,"I")))
+82 SET VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))
+83 KILL PXVARRAY
DO GETVIS(DA,.PXVARRAY)
+84 SET PXVIMIEN=REC(9000010.11,DA,.01,"I")
+85 SET SNIMM=$PIECE($GET(^AUTTIMM(PXVIMIEN,0)),U,2)
+86 SET IMM=REC(9000010.11,DA,.01,"E")
+87 IF PXFG="S"
Begin DoDot:4
+88 SET IMM=$EXTRACT(IMM,1,10)
+89 IF SNIMM']""
SET SNIMM=IMM
End DoDot:4
+90 SET PXVCVX=$PIECE($GET(^AUTTIMM(PXVIMIEN,0)),U,3)
+91 SET IMDT=REC(9000010.11,DA,1201,"I")
+92 if IMDT']""
SET IMDT=$PIECE(VDATA,U)
+93 ; Screen entry based off PXFILTER criteria.
+94 SET PXVSTOP=$$SCREEN($GET(PXFILTER),PXVIMIEN,PXVCVX,.PXVCNT,IMDT)
if PXVSTOP
QUIT
+95 DO GETSORT(PXFG,IMDT,IMM,SNIMM,.PXSORT,.PXSORT2)
+96 SET SERIESC=REC(9000010.11,DA,.04,"I")
+97 SET SERIES=REC(9000010.11,DA,.04,"E")
+98 SET REACT=REC(9000010.11,DA,.06,"E")
+99 SET CONT=REC(9000010.11,DA,.07,"I")
+100 SET OPROV=REC(9000010.11,DA,1202,"E")
+101 SET EPROV=REC(9000010.11,DA,1204,"E")
+102 ;documenter
SET PXVDOCBY=REC(9000010.11,DA,1206,"E")
+103 ;ordered by policy
SET PXVBYPOL=REC(9000010.11,DA,1222,"I")
+104 ;admin route
IF +REC(9000010.11,DA,1302,"I")
SET PXVROUTE=REC(9000010.11,DA,1302,"E")
+105 ;admin site
SET PXVBODY=REC(9000010.11,DA,1303,"E")
+106 ;dose
SET PXVDOSE=REC(9000010.11,DA,1312.5,"E")
+107 ;results
SET PXVRSLT=REC(9000010.11,DA,1401,"E")
+108 ;reading
SET PXVRDNG=REC(9000010.11,DA,1402,"E")
+109 ;date/time read
SET PXVDTRD=REC(9000010.11,DA,1403,"I")
+110 ;reader
SET PXVRDR=REC(9000010.11,DA,1404,"E")
+111 ;reading recorded
SET PXVDTRCRD=REC(9000010.11,DA,1405,"I")
+112 ;hours reaad post-inoculation
SET PXVHRS=REC(9000010.11,DA,1406,"E")
+113 ;reading comment
SET PXVRCMNT=REC(9000010.11,DA,1501,"E")
+114 SET SOURCE=REC(9000010.11,DA,80102,"E")
+115 SET COMMENT=REC(9000010.11,DA,81101,"E")
+116 SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,0)=IMM_U_SNIMM_U_IMDT_U_SERIESC_U_SERIES_U_REACT_U_CONT_U_OPROV_U_EPROV_U_PXVBYPOL
+117 SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,1)=$$GETENCLOC(VDATA)
+118 ;new
SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,2)=$GET(PXVROUTE)_U_PXVBODY_U_PXVDOSE_U_PXVDOCBY
+119 ;new
SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,3)=PXVDATA
+120 ;new
SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,4)=PXVRSLT_U_PXVRDNG_U_PXVDTRD_U_PXVRDR_U_PXVDTRCRD_U_PXVHRS
+121 ;new
SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,"RCOM")=PXVRCMNT
+122 SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,"S")=SOURCE
+123 SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,"COM")=COMMENT
+124 ;new VIS array
MERGE ^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,"VIS")=PXVARRAY(920)
+125 DO PUTIMMNAME(PXIMM,$NAME(^TMP("PXI",$JOB,PXSORT,PXSORT2,DA,"FN")))
+126 ;in original not used
DO GETREM(PXSORT,PXSORT2,DA)
End DoDot:3
End DoDot:2
End DoDot:1
+127 QUIT
SETUP(GMTSMX,IHSDATE,PXVLST,PXOLD,PXNOINV) ;Prepare for data extract
+1 NEW PXVIEN
+2 SET GMTSMX=$SELECT(+$GET(GMTSNDM)>0:GMTSNDM,1:999)
SET PXNOINV=+$GET(PXNOINV)
+3 IF PXNOINV
SET IHSDATE=$$HSDATE^PXRHS01
+4 IF '$TEST
SET IHSDATE=9999999-$$HSDATE^PXRHS01
+5 ; if selected records are requested, get IENs and store in a list
+6 IF $GET(GMTSEGN)
IF $DATA(GMTSEG(GMTSEGN,9999999.14))
SET PXVIEN=0
FOR
SET PXVIEN=$ORDER(GMTSEG(GMTSEGN,9999999.14,PXVIEN))
if PXVIEN=""
QUIT
Begin DoDot:1
+7 SET PXVLST(GMTSEG(GMTSEGN,9999999.14,PXVIEN))=""
End DoDot:1
+8 IF $GET(PXFG)=""
SET PXFG=$SELECT(PXOLD:"S",1:"A")
+9 QUIT
SCREEN(PXFILTER,PXVIMIEN,PXVCVX,PXVCNT,PXIMDT) ;Filter entry based on criteria
+1 NEW PXVFLTRTYP,PXVFLTRVAL,PXVSTOP,PXVABRV,PXVG
+2 SET PXVSTOP=0
+3 ;Check filter criteria
+4 IF $GET(PXFILTER)'=""
Begin DoDot:1
+5 SET PXVFLTRTYP=$PIECE(PXFILTER,":",1)
SET PXVFLTRVAL=$PIECE(PXFILTER,":",2)
+6 IF (PXVFLTRTYP="")!(PXVFLTRVAL="")
QUIT
+7 IF PXVFLTRTYP="G"
IF '$DATA(^AUTTIMM(PXVIMIEN,7,"B",PXVFLTRVAL))
SET PXVSTOP=1
+8 IF PXVFLTRTYP="I"
IF PXVFLTRVAL'=PXVIMIEN
SET PXVSTOP=1
+9 IF PXVFLTRTYP="C"
IF PXVFLTRVAL'=PXVCVX
SET PXVSTOP=1
End DoDot:1
if PXVSTOP
QUIT PXVSTOP
+10 ;Check time and occurence limits for non-IM health summary components
+11 SET PXVCNT(PXIMM)=1+$GET(PXVCNT(PXIMM))
SET PXVABRV=""
+12 IF $GET(GMTSE)
DO GETS^DIQ(142.1,GMTSE,"3","","PXVG")
SET PXVABRV=PXVG(142.1,GMTSE_",",3)
+13 IF PXVABRV'="IM"
IF $GET(GMTSBEG)
IF (PXIMDT\1)<(GMTSBEG\1)!(PXVCNT(PXIMM)>GMTSMX)
SET PXVSTOP=1
+14 QUIT PXVSTOP
GETSORT(PXFG,PXIMDT,PXIMMEXT,PXSNIMM,PXSORT,PXSORT2) ;RETURN THE SORTING SUBSCRIPTS FOR ^TMP
+1 NEW PXIDT
+2 ;Set date as chronological or reverse chronological
+3 SET PXIDT=$SELECT(PXFG="C":PXIMDT,PXFG="S":9999999-PXIMDT,1:9999999-(PXIMDT\1))
+4 ;Primary sort subscript
+5 SET PXSORT=$SELECT(PXFG="A":PXIMMEXT,PXFG="S":PXSNIMM,1:PXIDT\1)
+6 ;Secondary sort subscript
+7 SET PXSORT2=$SELECT(PXFG="A":PXIDT\1,PXFG="S":PXIDT,1:PXIMMEXT)
+8 QUIT
GETENCLOC(PXVDATA) ;Get encounter location data for extract
+1 QUIT $PIECE(PXVDATA,U,5)_U_$PIECE(PXVDATA,U,6)_U_$PIECE(PXVDATA,U,2)_U_$PIECE(PXVDATA,U,4)
GETREM(PXSORT,PXSORT2,RNUM) ;Get the remark data
+1 NEW CNT
+2 SET CNT=0
+3 FOR
SET CNT=$ORDER(^AUPNVIMM(RNUM,11,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+4 SET ^TMP("PXI",$JOB,PXSORT,PXSORT2,RNUM,"R",CNT)=$GET(^AUPNVIMM(RNUM,11,CNT,0))
End DoDot:1
+5 QUIT
GETVDATA(DA) ;Get location of encounter and outside location from visit file
+1 NEW DIC,DIQ,DR,VREC,HLOC,HLOCABB
+2 SET DIC=9000010
SET DIQ="VREC("
SET DIQ(0)="IE"
+3 SET DR=".01;.06;.07;.22;2101"
+4 DO EN^DIQ1
+5 SET HLOC=VREC(9000010,DA,.22,"E")
+6 SET HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))
+7 QUIT VREC(9000010,DA,.01,"I")_U_VREC(9000010,DA,.06,"E")_U_VREC(9000010,DA,.07,"I")_U_VREC(9000010,DA,2101,"E")_U_HLOC_U_HLOCABB
GETMDATA(DA) ;Get Manufacturer, lot number and expiration date
+1 ; Input DA ien of IMMUNIZATION LOT
+2 ; Output MREC LOT NUMBER^MANUFACTURER^EXPIRATION DATE
+3 NEW DIC,DR,MREC,DIQ
+4 IF '$DATA(^AUTTIML(+$GET(DA)))
QUIT ""
+5 SET DIQ="MREC"
SET DIQ(0)="IE"
+6 SET DIC=9999999.41
SET DR=".01;.02;.09"
+7 DO EN^DIQ1
+8 QUIT MREC(9999999.41,DA,.01,"E")_U_MREC(9999999.41,DA,.02,"E")_U_MREC(9999999.41,DA,.09,"I")
PUTIMMNAME(PXIMMIFN,PXGLOBAL) ;Put full immunization name into output global
+1 NEW PXVC
+2 SET PXVC=0
FOR
SET PXVC=$ORDER(^AUTTIMM(PXIMMIFN,2,PXVC))
if PXVC'>0
QUIT
Begin DoDot:1
+3 SET @PXGLOBAL@(PXVC)=$GET(^AUTTIMM(PXIMMIFN,2,PXVC,0))
End DoDot:1
+4 QUIT
GETVIS(PXVI,PXVARRAY) ;Get multiple VIS with edition date
+1 ; Input PXVI ien of IMMUNIZATION record
+2 ; Output PXVARRAY array of VIS names ^ edition dates
+3 NEW DIC,DR,PXVIEN,DA,DIQ,SREC
+4 SET PXVIEN=""
SET DIQ="SREC"
SET DIQ(0)="IE"
+5 FOR
SET PXVIEN=$ORDER(^AUPNVIMM(PXVI,2,"B",PXVIEN))
if PXVIEN=""
QUIT
Begin DoDot:1
+6 SET DIC=920
SET DR=".01;.02"
SET DA=+PXVIEN
+7 IF '$DATA(^AUTTIVIS(DA))
QUIT
+8 DO EN^DIQ1
+9 SET PXVARRAY(920,PXVIEN)=SREC(920,PXVIEN,.01,"E")_U_SREC(920,PXVIEN,.02,"I")
End DoDot:1
+10 QUIT
CONREF(DFN,PXFG,PXFILTER) ;Contraindicated and refused immunizations
+1 ;INPUT : DFN - Pointer to PATIENT file (#2)
+2 ; : PXFG - Primary sort order
+3 ; "A": (Default) Alphabetical by Immunization Name
+4 ; "C": Chronological
+5 ; "R": Reverse Chronological
+6 ;
+7 ; : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
+8 ; "G:XXX": Only include immunizations for Vaccine Group Name XXX
+9 ; "I:XXX": Only include immunizations for Immunization IEN XXX
+10 ; "C:XXX": Only include immunizations for CVX code XXX
+11 ;
+12 ;OUTPUT :
+13 ; Data from V IMM CONTRA/REFUSAL EVENTS file (#9000010.707)
+14 ; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,0) = IMMUNIZATION [E;.04] ^
+15 ; EVENT DATE/TIME [I;1201] or VISIT/ADMIT DATE&TIME [I;.03] ^
+16 ; TYPE [VARIABLE POINTER PREFIX;.01] ^ CONTRAINDICATION/REFUSAL [E;.01] ^
+17 ; WARN UNTIL DATE [I;.05] ^ REFUSED VACCINE GROUP [E;1205] ^
+18 ; ENCOUNTER PROVIDER [E;1204] ^ CONTRAINDICATION/PRECAUTION [E;920.4;.06]
+19 ; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,1) = HOSPITAL LOCATION [E;9000010;.22] ^
+20 ; HOSP. LOC. ABBREVIATION [E;44;1] ^ LOC OF ENCOUNTER [E;9000010;.06] ^
+21 ; OUTSIDE LOC [E;9000010;2101]
+22 ; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"COM") = COMMENTS [E;81101]
+23 ; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"RGROUP",GNAME,IMMIEN) = IMMUNIZATION [E;.04]
+24 ; ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
+25 ;
+26 ; [] = [I(nternal)/E(xternal); Optional file #; Field #]
+27 ; Subscripts:
+28 ; If PXFG
+29 ; Equals: Then subscript will be:
+30 ; ======= ===========================
+31 ; PXSORT - A Immunization Name
+32 ; C Fileman date of DATE OF event or visit
+33 ; R Inverse Fileman date of DATE OF event or visit
+34 ; PXSORT2 - C or R Immunization name
+35 ; A Inverse Fileman date of DATE OF event or visit
+36 ; PXSORT3 - A, C, R Type; C for Contraindication or R for Refusal
+37 ;
+38 ; IFN - Internal Record #
+39 if +$GET(DFN)<1!('$DATA(^AUPNVICR("AB",DFN)))
QUIT
+40 NEW GMTSMX,PXHSDATE,PXVLST,PXIMM,PXVD,PXIFN,PXVCVX,PXVDATA,PXEVENTDT,PXN0
+41 NEW PXERROR,PXVSTOP,PXVCNT,PXSORT,PXSORT2,PXEVENT,PXFILE,PXTYPE,PXCOPR,PXCIIFN
+42 NEW PXRETURN,PXENTRIES
+43 KILL ^TMP("PXCRI",$JOB)
+44 DO SETUP(.GMTSMX,.PXHSDATE,.PXVLST,0,1)
+45 SET PXIMM=0
FOR
SET PXIMM=$ORDER(^AUPNVICR("AB",DFN,PXIMM))
if '+PXIMM
QUIT
Begin DoDot:1
+46 IF $DATA(PXVLST)
IF '$DATA(PXVLST(PXIMM))
QUIT
+47 SET PXVD=":"
FOR
SET PXVD=$ORDER(^AUPNVICR("AB",DFN,PXIMM,PXVD),-1)
if '+PXVD
QUIT
if PXVD<PXHSDATE
QUIT
Begin DoDot:2
+48 SET PXIFN=0
FOR
SET PXIFN=$ORDER(^AUPNVICR("AB",DFN,PXIMM,PXVD,PXIFN))
if '+PXIFN
QUIT
Begin DoDot:3
+49 IF '$DATA(^AUPNVICR(PXIFN,0))
QUIT
+50 SET PXENTRIES(PXIFN)=""
End DoDot:3
End DoDot:2
End DoDot:1
+51 SET PXIMM=0
FOR
SET PXIMM=$ORDER(PXVLST(PXIMM))
if '+PXIMM
QUIT
Begin DoDot:1
+52 DO PATICR^PXAPIIM(.PXRETURN,DFN,PXIMM,1600101,,1)
+53 SET PXIFN=0
FOR
SET PXIFN=$ORDER(PXRETURN(PXIFN))
if '+PXIFN
QUIT
Begin DoDot:2
+54 IF '$DATA(PXENTRIES(PXIFN))
SET PXENTRIES(PXIFN)=""
End DoDot:2
End DoDot:1
+55 SET PXIFN=0
FOR
SET PXIFN=$ORDER(PXENTRIES(PXIFN))
if '+PXIFN
QUIT
Begin DoDot:1
+56 SET PXIMM=$PIECE($GET(^AUPNVICR(PXIFN,0)),U,4)
+57 NEW PXERROR,PXRESULT,PXDATA
+58 SET PXVCVX=$PIECE($GET(^AUTTIMM(PXIMM,0)),U,3)
+59 SET PXVDATA=$$GETVDATA($PIECE($GET(^AUPNVICR(PXIFN,0)),U,3))
+60 SET PXEVENTDT=$PIECE($GET(^AUPNVICR(PXIFN,12)),U,1)
+61 IF PXEVENTDT=""
SET PXEVENTDT=$PIECE(PXVDATA,U,1)
+62 SET PXVSTOP=$$SCREEN($GET(PXFILTER),PXIMM,PXVCVX,.PXVCNT,PXEVENTDT)
if PXVSTOP
QUIT
+63 DO GETS^DIQ(9000010.707,PXIFN_",",".01;.04;1204;1205;81101","","PXDATA","PXERROR")
+64 IF $DATA(PXERROR)
QUIT
+65 DO GETSORT(PXFG,PXEVENTDT,PXDATA(9000010.707,PXIFN_",",.04),"",.PXSORT,.PXSORT2)
+66 SET PXEVENT=$PIECE($GET(^AUPNVICR(PXIFN,0)),U,1)
+67 DO FILE^DID(+$PIECE(PXEVENT,"(",2),"","NAME","PXFILE","PXERROR")
+68 IF $DATA(PXERROR)
QUIT
+69 SET PXTYPE=$EXTRACT($PIECE(PXFILE("NAME")," ",2),1)
+70 IF PXTYPE="C"
Begin DoDot:2
+71 NEW PXCDATA
+72 DO GETS^DIQ(920.4,$PIECE(PXEVENT,";",1)_",",".06;3*","","PXCDATA","PXERROR")
+73 IF $DATA(PXERROR)
QUIT
+74 SET PXCOPR=PXCDATA(920.4,$PIECE(PXEVENT,";",1)_",",.06)
+75 SET PXCIIFN=""
FOR
SET PXCIIFN=$ORDER(PXCDATA(920.43,PXCIIFN))
if PXCIIFN=""
QUIT
Begin DoDot:3
+76 SET ^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,"LIMITED",+PXCIIFN)=PXCDATA(920.43,PXCIIFN,.01)
End DoDot:3
End DoDot:2
+77 IF PXTYPE="R"
IF PXDATA(9000010.707,PXIFN_",",1205)="YES"
Begin DoDot:2
+78 DO IMMGRP^PXAPIIM(.PXRESULT,PXIMM)
+79 MERGE ^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,"RGROUP")=PXRESULT("VG")
End DoDot:2
+80 SET PXEVENT=PXDATA(9000010.707,PXIFN_",",.01)
+81 SET PXN0=PXDATA(9000010.707,PXIFN_",",.04)_U_PXEVENTDT_U_PXTYPE_U_PXEVENT_U
+82 SET PXN0=PXN0_$PIECE($GET(^AUPNVICR(PXIFN,0)),U,5)_U
+83 SET PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1205)_U
+84 SET PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1204)_U_$GET(PXCOPR)
+85 SET ^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,0)=PXN0
+86 SET ^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,1)=$$GETENCLOC(PXVDATA)
+87 SET ^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,"COM")=PXDATA(9000010.707,PXIFN_",",81101)
+88 DO PUTIMMNAME(PXIMM,$NAME(^TMP("PXCRI",$JOB,PXTYPE,PXSORT,PXSORT2,PXIFN,"FN")))
End DoDot:1
+89 QUIT
