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

PXRHS03.m

Go to the documentation of this file. 
  1. 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
  1. IMMUN(DFN,PXFG,PXFILTER) ;Administered immunizations
  1.  ;INPUT  : DFN      - Pointer to PATIENT file (#2)
  1.  ;       : PXFG     - Primary sort order
  1.  ;                    "S": (Default) Alphabetical by Immunization Short Name,
  1.  ;                                   or Name (if Short Name is null)
  1.  ;                         (Since Short Name is not standardized and is null
  1.  ;                          for newer immunization (post PX*1*201), the "S"
  1.  ;                          argument has been deprecated, and is only supported
  1.  ;                          for backward compatibility purposes).
  1.  ;                    "A": Alphabetical by Immunization Name
  1.  ;                    "C": Chronological
  1.  ;                    "R": Reverse Chronological
  1.  ;
  1.  ;       : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
  1.  ;                     "G:XXX": Only include immunizations for Vaccine Group Name XXX
  1.  ;                     "I:XXX": Only include immunizations for Immunization IEN XXX
  1.  ;                     "C:XXX": Only include immunizations for CVX code XXX
  1.  ;
  1.  ;OUTPUT :
  1.  ;  Data from V Immunization (9000010.11) file
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,0) = IMMUNIZATION [E;.01]
  1.  ;     ^ IMMUNIZATION SHORT NAME [E;9999999.14,.02]
  1.  ;     ^ EVENT DATE/TIME or VISIT/ADMIT DATE&TIME [I;1201 or .03]
  1.  ;     ^ SERIES CODE [I;.04] ^ SERIES [E;.04] ^ REACTION [E;.06]
  1.  ;     ^ CONTRAINDICATED [I;.07] ^ ORDERING PROVIDER [E;1202]
  1.  ;     ^ ENCOUNTER PROVIDER [E;1204] ^ ORDERED BY POLICY [I;1222]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,1) = HOSPITAL LOCATION [E;9000010;.22]
  1.  ;     ^ HOSP. LOC. ABBREVIATION [E;44;1]
  1.  ;     ^ LOC OF ENCOUNTER [E;9000010;.06] ^ OUTSIDE LOC [E;9000010;2101]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,2) = ROUTE OF ADMIN [E;1302]
  1.  ;     ^ SITE OF ADMIN [E;1303] ^ DOSAGE [E;1312.5] ^ DOCUMENTER [E;1206]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,3) = LOT [E;.05] ^ MANUF [E;9999999.41;.02]
  1.  ;     ^ EXP DATE [I;9999999.41;.09]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,4)= RESULTS [E;1401] ^ READING [E;1402]
  1.  ;     ^ DATE/TIME READ [I;1403] ^ READER [E;1404] ^ READING RECORDED [I;1405]
  1.  ;     ^ HOURS READ [E;1406]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"RCOM")= READING COMMENT [E;1501]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"R",CNT) = REMARKS [E;1101]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"S") = DATA SOURCE [E;80102]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"COM") = COMMENTS [E;81101]
  1.  ;  ^TMP("PXI",$J,PXSORT,PXSORT2,IFN,"VIS") = VIS OFFERED TO PATIENT [E;2]
  1.  ;     ^ EDITION DATE [I;920;.02]
  1.  ;
  1.  ;   [] = [I(nternal)/E(xternal); Optional file #; Record #]
  1.  ;   Subscripts:
  1.  ;                If PXFG
  1.  ;                Equals:    Then subscript will be:
  1.  ;                =======    ===========================
  1.  ;     PXSORT   -    S       Immunization short name,
  1.  ;                           or Name truncated to 10 characters (if short name is null)
  1.  ;                   A       Immunization Name
  1.  ;                   C       Fileman date of DATE OF event or visit
  1.  ;                   R       Inverse Fileman date of DATE OF event or visit
  1.  ;     PXSORT2  -  C or R    Immunization name
  1.  ;              -  A or S    Inverse Fileman date of DATE OF event or visit
  1.  ;
  1.  ;     IFN   - Internal Record #
  1.  ;
  1.  Q:$G(DFN)']""!'$D(^AUPNVIMM("AA",DFN))
  1.  N PXIMM,PXIVD,PXIFN,IHSDATE
  1.  N PXVLST,PXSORT,PXSORT2,PXVCNT,GMTSMX
  1.  K ^TMP("PXI",$J)
  1.  D SETUP(.GMTSMX,.IHSDATE,.PXVLST,1)
  1.  S PXIMM=""
  1.  F  S PXIMM=$O(^AUPNVIMM("AA",DFN,PXIMM)) Q:PXIMM=""  D
  1.  . I $D(PXVLST),'$D(PXVLST(PXIMM)) Q
  1.  . S PXIVD=0
  1.  . F  S PXIVD=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD)) Q:PXIVD'>0  Q:PXIVD>IHSDATE  D
  1.  . . S PXIFN=0
  1.  . . F  S PXIFN=$O(^AUPNVIMM("AA",DFN,PXIMM,PXIVD,PXIFN)) Q:PXIFN'>0  D
  1.  . . . N DIC,DIQ,DR,DA,REC,IMM,SNIMM,IMDT,SERIESC,SERIES,REACT,CONT
  1.  . . . N OPROV,EPROV,SOURCE,VDATA,IDT,COMMENT
  1.  . . . N PXVROUTE,PXVBODY,PXVDOSE,PXVARRAY,PXVC,PXVDATA,PXVDOCBY
  1.  . . . N PXVRSLT,PXVRDNG,PXVDTRD,PXVRDR,PXVDTRCRD,PXVHRS,PXVRCMNT,PXVIMIEN
  1.  . . . N PXVSTOP,PXVCVX,PXVBYPOL
  1.  . . . S DIC=9000010.11,DA=PXIFN,DIQ="REC(",DIQ(0)="IE"
  1.  . . . S DR=".01;.03;.04;.06;.07;1201;1202;1204;1206;1207;1222;80102;81101;1302;1303;1312.5"
  1.  . . . S DR=DR_";1401;1402;1403;1404;1405;1406;1501"
  1.  . . . D EN^DIQ1
  1.  . . . I '$D(REC) Q
  1.  . . . S PXVDATA=$S('+REC(9000010.11,DA,1207,"I"):"",1:$$GETMDATA(+REC(9000010.11,DA,1207,"I")))  ;manuf,lot #,exp dt
  1.  . . . S VDATA=$$GETVDATA(+REC(9000010.11,DA,.03,"I"))
  1.  . . . K PXVARRAY D GETVIS(DA,.PXVARRAY)
  1.  . . . S PXVIMIEN=REC(9000010.11,DA,.01,"I")
  1.  . . . S SNIMM=$P($G(^AUTTIMM(PXVIMIEN,0)),U,2)
  1.  . . . S IMM=REC(9000010.11,DA,.01,"E")
  1.  . . . I PXFG="S" D
  1.  . . . . S IMM=$E(IMM,1,10)
  1.  . . . . I SNIMM']"" S SNIMM=IMM
  1.  . . . S PXVCVX=$P($G(^AUTTIMM(PXVIMIEN,0)),U,3)
  1.  . . . S IMDT=REC(9000010.11,DA,1201,"I")
  1.  . . . S:IMDT']"" IMDT=$P(VDATA,U)
  1.  . . . ; Screen entry based off PXFILTER criteria.
  1.  . . . S PXVSTOP=$$SCREEN($G(PXFILTER),PXVIMIEN,PXVCVX,.PXVCNT,IMDT) Q:PXVSTOP
  1.  . . . D GETSORT(PXFG,IMDT,IMM,SNIMM,.PXSORT,.PXSORT2)
  1.  . . . S SERIESC=REC(9000010.11,DA,.04,"I")
  1.  . . . S SERIES=REC(9000010.11,DA,.04,"E")
  1.  . . . S REACT=REC(9000010.11,DA,.06,"E")
  1.  . . . S CONT=REC(9000010.11,DA,.07,"I")
  1.  . . . S OPROV=REC(9000010.11,DA,1202,"E")
  1.  . . . S EPROV=REC(9000010.11,DA,1204,"E")
  1.  . . . S PXVDOCBY=REC(9000010.11,DA,1206,"E") ;documenter
  1.  . . . S PXVBYPOL=REC(9000010.11,DA,1222,"I") ;ordered by policy
  1.  . . . I +REC(9000010.11,DA,1302,"I") S PXVROUTE=REC(9000010.11,DA,1302,"E")  ;admin route
  1.  . . . S PXVBODY=REC(9000010.11,DA,1303,"E")  ;admin site
  1.  . . . S PXVDOSE=REC(9000010.11,DA,1312.5,"E")  ;dose
  1.  . . . S PXVRSLT=REC(9000010.11,DA,1401,"E") ;results
  1.  . . . S PXVRDNG=REC(9000010.11,DA,1402,"E") ;reading
  1.  . . . S PXVDTRD=REC(9000010.11,DA,1403,"I") ;date/time read
  1.  . . . S PXVRDR=REC(9000010.11,DA,1404,"E") ;reader
  1.  . . . S PXVDTRCRD=REC(9000010.11,DA,1405,"I") ;reading recorded
  1.  . . . S PXVHRS=REC(9000010.11,DA,1406,"E") ;hours reaad post-inoculation
  1.  . . . S PXVRCMNT=REC(9000010.11,DA,1501,"E") ;reading comment
  1.  . . . S SOURCE=REC(9000010.11,DA,80102,"E")
  1.  . . . S COMMENT=REC(9000010.11,DA,81101,"E")
  1.  . . . 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
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,1)=$$GETENCLOC(VDATA)
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,2)=$G(PXVROUTE)_U_PXVBODY_U_PXVDOSE_U_PXVDOCBY  ;new
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,3)=PXVDATA  ;new
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,4)=PXVRSLT_U_PXVRDNG_U_PXVDTRD_U_PXVRDR_U_PXVDTRCRD_U_PXVHRS ;new
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"RCOM")=PXVRCMNT ;new
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"S")=SOURCE
  1.  . . . S ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"COM")=COMMENT
  1.  . . . M ^TMP("PXI",$J,PXSORT,PXSORT2,DA,"VIS")=PXVARRAY(920)  ;new VIS array
  1.  . . . D PUTIMMNAME(PXIMM,$NA(^TMP("PXI",$J,PXSORT,PXSORT2,DA,"FN")))
  1.  . . . D GETREM(PXSORT,PXSORT2,DA)  ;in original not used
  1.  Q
  1. SETUP(GMTSMX,IHSDATE,PXVLST,PXOLD,PXNOINV) ;Prepare for data extract
  1.  N PXVIEN
  1.  S GMTSMX=$S(+$G(GMTSNDM)>0:GMTSNDM,1:999),PXNOINV=+$G(PXNOINV)
  1.  I PXNOINV S IHSDATE=$$HSDATE^PXRHS01
  1.  E  S IHSDATE=9999999-$$HSDATE^PXRHS01
  1.  ; if selected records are requested, get IENs and store in a list
  1.  I $G(GMTSEGN),$D(GMTSEG(GMTSEGN,9999999.14)) S PXVIEN=0 F  S PXVIEN=$O(GMTSEG(GMTSEGN,9999999.14,PXVIEN)) Q:PXVIEN=""  D
  1.  . S PXVLST(GMTSEG(GMTSEGN,9999999.14,PXVIEN))=""
  1.  I $G(PXFG)="" S PXFG=$S(PXOLD:"S",1:"A")
  1.  Q
  1. SCREEN(PXFILTER,PXVIMIEN,PXVCVX,PXVCNT,PXIMDT) ;Filter entry based on criteria
  1.  N PXVFLTRTYP,PXVFLTRVAL,PXVSTOP,PXVABRV,PXVG
  1.  S PXVSTOP=0
  1.  ;Check filter criteria
  1.  I $G(PXFILTER)'="" D  Q:PXVSTOP PXVSTOP
  1.  .S PXVFLTRTYP=$P(PXFILTER,":",1),PXVFLTRVAL=$P(PXFILTER,":",2)
  1.  .I (PXVFLTRTYP="")!(PXVFLTRVAL="") Q
  1.  .I PXVFLTRTYP="G",'$D(^AUTTIMM(PXVIMIEN,7,"B",PXVFLTRVAL)) S PXVSTOP=1
  1.  .I PXVFLTRTYP="I",PXVFLTRVAL'=PXVIMIEN S PXVSTOP=1
  1.  .I PXVFLTRTYP="C",PXVFLTRVAL'=PXVCVX S PXVSTOP=1
  1.  ;Check time and occurence limits for non-IM health summary components
  1.  S PXVCNT(PXIMM)=1+$G(PXVCNT(PXIMM)),PXVABRV=""
  1.  I $G(GMTSE) D GETS^DIQ(142.1,GMTSE,"3","","PXVG") S PXVABRV=PXVG(142.1,GMTSE_",",3)
  1.  I PXVABRV'="IM",$G(GMTSBEG) I (PXIMDT\1)<(GMTSBEG\1)!(PXVCNT(PXIMM)>GMTSMX) S PXVSTOP=1
  1.  Q PXVSTOP
  1. GETSORT(PXFG,PXIMDT,PXIMMEXT,PXSNIMM,PXSORT,PXSORT2) ;RETURN THE SORTING SUBSCRIPTS FOR ^TMP
  1.  N PXIDT
  1.  ;Set date as chronological or reverse chronological
  1.  S PXIDT=$S(PXFG="C":PXIMDT,PXFG="S":9999999-PXIMDT,1:9999999-(PXIMDT\1))
  1.  ;Primary sort subscript
  1.  S PXSORT=$S(PXFG="A":PXIMMEXT,PXFG="S":PXSNIMM,1:PXIDT\1)
  1.  ;Secondary sort subscript
  1.  S PXSORT2=$S(PXFG="A":PXIDT\1,PXFG="S":PXIDT,1:PXIMMEXT)
  1.  Q
  1. GETENCLOC(PXVDATA) ;Get encounter location data for extract
  1.  Q $P(PXVDATA,U,5)_U_$P(PXVDATA,U,6)_U_$P(PXVDATA,U,2)_U_$P(PXVDATA,U,4)
  1. GETREM(PXSORT,PXSORT2,RNUM) ;Get the remark data
  1.  N CNT
  1.  S CNT=0
  1.  F  S CNT=$O(^AUPNVIMM(RNUM,11,CNT)) Q:CNT'>0  D
  1.  . S ^TMP("PXI",$J,PXSORT,PXSORT2,RNUM,"R",CNT)=$G(^AUPNVIMM(RNUM,11,CNT,0))
  1.  Q
  1. GETVDATA(DA) ;Get location of encounter and outside location from visit file
  1.  N DIC,DIQ,DR,VREC,HLOC,HLOCABB
  1.  S DIC=9000010,DIQ="VREC(",DIQ(0)="IE"
  1.  S DR=".01;.06;.07;.22;2101"
  1.  D EN^DIQ1
  1.  S HLOC=VREC(9000010,DA,.22,"E")
  1.  S HLOCABB=$$GETHLOC^PXRHS02(+VREC(9000010,DA,.22,"I"))
  1.  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
  1. GETMDATA(DA)  ;Get Manufacturer, lot number and expiration date
  1.  ;   Input   DA       ien of IMMUNIZATION LOT
  1.  ;   Output  MREC     LOT NUMBER^MANUFACTURER^EXPIRATION DATE
  1.  N DIC,DR,MREC,DIQ
  1.  I '$D(^AUTTIML(+$G(DA))) Q ""
  1.  S DIQ="MREC",DIQ(0)="IE"
  1.  S DIC=9999999.41,DR=".01;.02;.09"
  1.  D EN^DIQ1
  1.  Q MREC(9999999.41,DA,.01,"E")_U_MREC(9999999.41,DA,.02,"E")_U_MREC(9999999.41,DA,.09,"I")
  1. PUTIMMNAME(PXIMMIFN,PXGLOBAL) ;Put full immunization name into output global
  1.  N PXVC
  1.  S PXVC=0 F  S PXVC=$O(^AUTTIMM(PXIMMIFN,2,PXVC)) Q:PXVC'>0  D
  1.  .S @PXGLOBAL@(PXVC)=$G(^AUTTIMM(PXIMMIFN,2,PXVC,0))
  1.  Q
  1. GETVIS(PXVI,PXVARRAY) ;Get multiple VIS with edition date
  1.  ;  Input   PXVI      ien of IMMUNIZATION record
  1.  ;  Output  PXVARRAY  array of VIS names ^ edition dates
  1.  N DIC,DR,PXVIEN,DA,DIQ,SREC
  1.  S PXVIEN="",DIQ="SREC",DIQ(0)="IE"
  1.  F  S PXVIEN=$O(^AUPNVIMM(PXVI,2,"B",PXVIEN)) Q:PXVIEN=""  D
  1.  . S DIC=920,DR=".01;.02",DA=+PXVIEN
  1.  . I '$D(^AUTTIVIS(DA)) Q
  1.  . D EN^DIQ1
  1.  . S PXVARRAY(920,PXVIEN)=SREC(920,PXVIEN,.01,"E")_U_SREC(920,PXVIEN,.02,"I")
  1.  Q
  1. CONREF(DFN,PXFG,PXFILTER) ;Contraindicated and refused immunizations
  1.  ;INPUT  : DFN      - Pointer to PATIENT file (#2)
  1.  ;       : PXFG     - Primary sort order
  1.  ;                    "A": (Default) Alphabetical by Immunization Name
  1.  ;                    "C": Chronological
  1.  ;                    "R": Reverse Chronological
  1.  ;
  1.  ;       : PXFILTER - (Optional) Allows filtering based off Vaccine Group Name, IEN, or CVX
  1.  ;                     "G:XXX": Only include immunizations for Vaccine Group Name XXX
  1.  ;                     "I:XXX": Only include immunizations for Immunization IEN XXX
  1.  ;                     "C:XXX": Only include immunizations for CVX code XXX
  1.  ;
  1.  ;OUTPUT :
  1.  ;  Data from V IMM CONTRA/REFUSAL EVENTS file (#9000010.707)
  1.  ;  ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,0) = IMMUNIZATION [E;.04] ^
  1.  ;     EVENT DATE/TIME [I;1201] or VISIT/ADMIT DATE&TIME [I;.03] ^
  1.  ;     TYPE [VARIABLE POINTER PREFIX;.01] ^ CONTRAINDICATION/REFUSAL [E;.01] ^
  1.  ;     WARN UNTIL DATE [I;.05] ^ REFUSED VACCINE GROUP [E;1205] ^
  1.  ;     ENCOUNTER PROVIDER [E;1204] ^ CONTRAINDICATION/PRECAUTION [E;920.4;.06]
  1.  ;  ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,1) = HOSPITAL LOCATION [E;9000010;.22] ^
  1.  ;     HOSP. LOC. ABBREVIATION [E;44;1] ^ LOC OF ENCOUNTER [E;9000010;.06] ^
  1.  ;     OUTSIDE LOC [E;9000010;2101]
  1.  ;  ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"COM") = COMMENTS [E;81101]
  1.  ;  ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"RGROUP",GNAME,IMMIEN) = IMMUNIZATION [E;.04]
  1.  ;  ^TMP("PXCRI",$J,PXSORT,PXSORT2,PXSORT3,IFN,"FN",CNT) = CDC FULL VACCINE NAME [E;9999999.14;2]
  1.  ;
  1.  ;   [] = [I(nternal)/E(xternal); Optional file #; Field #]
  1.  ;   Subscripts:
  1.  ;                If PXFG
  1.  ;                Equals:    Then subscript will be:
  1.  ;                =======    ===========================
  1.  ;     PXSORT   -    A       Immunization Name
  1.  ;                   C       Fileman date of DATE OF event or visit
  1.  ;                   R       Inverse Fileman date of DATE OF event or visit
  1.  ;     PXSORT2  -  C or R    Immunization name
  1.  ;                 A         Inverse Fileman date of DATE OF event or visit
  1.  ;     PXSORT3  -  A, C, R   Type; C for Contraindication or R for Refusal
  1.  ;
  1.  ;     IFN   - Internal Record #
  1.  Q:+$G(DFN)<1!('$D(^AUPNVICR("AB",DFN)))
  1.  N GMTSMX,PXHSDATE,PXVLST,PXIMM,PXVD,PXIFN,PXVCVX,PXVDATA,PXEVENTDT,PXN0
  1.  N PXERROR,PXVSTOP,PXVCNT,PXSORT,PXSORT2,PXEVENT,PXFILE,PXTYPE,PXCOPR,PXCIIFN
  1.  N PXRETURN,PXENTRIES
  1.  K ^TMP("PXCRI",$J)
  1.  D SETUP(.GMTSMX,.PXHSDATE,.PXVLST,0,1)
  1.  S PXIMM=0 F  S PXIMM=$O(^AUPNVICR("AB",DFN,PXIMM)) Q:'+PXIMM  D
  1.  .I $D(PXVLST),'$D(PXVLST(PXIMM)) Q
  1.  .S PXVD=":" F  S PXVD=$O(^AUPNVICR("AB",DFN,PXIMM,PXVD),-1) Q:'+PXVD  Q:PXVD<PXHSDATE  D
  1.  ..S PXIFN=0 F  S PXIFN=$O(^AUPNVICR("AB",DFN,PXIMM,PXVD,PXIFN)) Q:'+PXIFN  D
  1.  ...I '$D(^AUPNVICR(PXIFN,0)) Q
  1.  ...S PXENTRIES(PXIFN)=""
  1.  S PXIMM=0 F  S PXIMM=$O(PXVLST(PXIMM)) Q:'+PXIMM  D
  1.  .D PATICR^PXAPIIM(.PXRETURN,DFN,PXIMM,1600101,,1)
  1.  .S PXIFN=0 F  S PXIFN=$O(PXRETURN(PXIFN)) Q:'+PXIFN  D
  1.  ..I '$D(PXENTRIES(PXIFN)) S PXENTRIES(PXIFN)=""
  1.  S PXIFN=0 F  S PXIFN=$O(PXENTRIES(PXIFN)) Q:'+PXIFN  D
  1.  .S PXIMM=$P($G(^AUPNVICR(PXIFN,0)),U,4)
  1.  .N PXERROR,PXRESULT,PXDATA
  1.  .S PXVCVX=$P($G(^AUTTIMM(PXIMM,0)),U,3)
  1.  .S PXVDATA=$$GETVDATA($P($G(^AUPNVICR(PXIFN,0)),U,3))
  1.  .S PXEVENTDT=$P($G(^AUPNVICR(PXIFN,12)),U,1)
  1.  .I PXEVENTDT="" S PXEVENTDT=$P(PXVDATA,U,1)
  1.  .S PXVSTOP=$$SCREEN($G(PXFILTER),PXIMM,PXVCVX,.PXVCNT,PXEVENTDT) Q:PXVSTOP
  1.  .D GETS^DIQ(9000010.707,PXIFN_",",".01;.04;1204;1205;81101","","PXDATA","PXERROR")
  1.  .I $D(PXERROR) Q
  1.  .D GETSORT(PXFG,PXEVENTDT,PXDATA(9000010.707,PXIFN_",",.04),"",.PXSORT,.PXSORT2)
  1.  .S PXEVENT=$P($G(^AUPNVICR(PXIFN,0)),U,1)
  1.  .D FILE^DID(+$P(PXEVENT,"(",2),"","NAME","PXFILE","PXERROR")
  1.  .I $D(PXERROR) Q
  1.  .S PXTYPE=$E($P(PXFILE("NAME")," ",2),1)
  1.  .I PXTYPE="C" D
  1.  ..N PXCDATA
  1.  ..D GETS^DIQ(920.4,$P(PXEVENT,";",1)_",",".06;3*","","PXCDATA","PXERROR")
  1.  ..I $D(PXERROR) Q
  1.  ..S PXCOPR=PXCDATA(920.4,$P(PXEVENT,";",1)_",",.06)
  1.  ..S PXCIIFN="" F  S PXCIIFN=$O(PXCDATA(920.43,PXCIIFN)) Q:PXCIIFN=""  D
  1.  ...S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"LIMITED",+PXCIIFN)=PXCDATA(920.43,PXCIIFN,.01)
  1.  .I PXTYPE="R",PXDATA(9000010.707,PXIFN_",",1205)="YES" D
  1.  ..D IMMGRP^PXAPIIM(.PXRESULT,PXIMM)
  1.  ..M ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"RGROUP")=PXRESULT("VG")
  1.  .S PXEVENT=PXDATA(9000010.707,PXIFN_",",.01)
  1.  .S PXN0=PXDATA(9000010.707,PXIFN_",",.04)_U_PXEVENTDT_U_PXTYPE_U_PXEVENT_U
  1.  .S PXN0=PXN0_$P($G(^AUPNVICR(PXIFN,0)),U,5)_U
  1.  .S PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1205)_U
  1.  .S PXN0=PXN0_PXDATA(9000010.707,PXIFN_",",1204)_U_$G(PXCOPR)
  1.  .S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,0)=PXN0
  1.  .S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,1)=$$GETENCLOC(PXVDATA)
  1.  .S ^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"COM")=PXDATA(9000010.707,PXIFN_",",81101)
  1.  .D PUTIMMNAME(PXIMM,$NA(^TMP("PXCRI",$J,PXTYPE,PXSORT,PXSORT2,PXIFN,"FN")))
  1.  Q