PXVRPC2 ;BPFO/LMT - PCE RPCs for IMM Source, Route, Site ;Jun 04, 2019@12:16:35
;;1.0;PCE PATIENT CARE ENCOUNTER;**215,217**;Aug 12, 1996;Build 134
;
; Reference to ^DIA(920.X,"C") supported by ICR #2602
;
;************************************************************************
;
;Input:
; PXVRSLT - (Required) Return value
; PXVFLTR - (Optional; Defaults to "S:B") Filter. Possible values are:
; R:XXX - Return entry with IEN XXX.
; H:XXX - Return entry with HL7 Code XXX.
; N:XXX - Return entry with #.01 field equal to XXX
; S:XY - Return all entries with a status of X.
; Possible values of X:
; A - Active Entries
; I - Inactive Entries
; B - Both active and inactive entries
; Possible values of Y (only applies to file 920.1):
; A - VA-Administered
; H - Historical
;
;Returns:
; PXVRSLT(0)=Count of elements returned (0 if nothing found)
; PXVRSLT(n)=IEN^Name^HL7 Code^Status (1:Active, 0:Inactive)
;
; For the IMMROUTE tag, see additional input and return values documented below.
;
; When filtering based off IEN, HL7 Code, or #.01 field, only one entry will be returned
; in PXVRSLT(1).
;
; When filtering based off status, multiple entries can be returned. The first entry will be
; returned in subscript 1, and subscripts will be incremented by 1 for further entries.
; Entries will be sorted alphabetically.
;
; If no entries are found based off the filtering criteria, PXVRSLT(0) will equal 0,
; and there will be no data returned in the subsequent subscripts.
;
;******************************************************************************
;
IMMSRC(PXVRSLT,PXVFLTR) ;
D GETDATA(.PXVRSLT,920.1,$G(PXVFLTR),"")
Q
;
IMMROUTE(PXVRSLT,PXVFLTR,PXVSITES) ;
; The following additional Input and Return values are available for IMMROUTE:
; Input:
; PXVSITES - (Optional) Controls if the available sites for a give route are returned
; Returns:
; If PXVSITES=1, the sites for a given route will be returned.
; o if If only a subset of sites are selectable for a route,
; that list will be returned in
; PXVRSLT(n+1)=SITE^Site IEN 1
; PXVRSLT(n+2)=SITE^Site IEN 2
; PXVRSLT(n+x)=SITE^Site IEN x
; o if all sites are selectable for a route, the RPC will return:
; PXVRSLT(n+1)=SITE^ALL
; o If no sites are selectable for a route, the RPC will return:
; PXVRSLT(n+1)=SITE^NONE
;
D GETDATA(.PXVRSLT,920.2,$G(PXVFLTR),$G(PXVSITES))
Q
;
IMMSITE(PXVRSLT,PXVFLTR,PXVDATE) ;
D GETDATA(.PXVRSLT,920.3,$G(PXVFLTR),"")
Q
;
;************************************************************************
;
GETDATA(PXVRSLT,PXFILE,PXVFLTR,PXVSITES) ;
;
N PXCNT,PXI,PXIEN,PXHL7,PXFKTRSTAT,PXFLTRTYP,PXFLTRVAL,PXFLTRSTAT,PXNAME,PXFLDS,PXSEQARR,PXSKIP,PXSTAT
S PXCNT=0
S PXIEN=""
S PXHL7=""
S PXFLTRTYP="S"
S PXFLTRSTAT="B"
D CHKCACHE(PXFILE)
;
I $G(PXVFLTR)'="" D
. S PXFLTRTYP=$P(PXVFLTR,":",1)
. S PXFLTRVAL=$P(PXVFLTR,":",2)
;
I PXFLTRTYP="R" D S PXVRSLT(0)=PXCNT Q
. S PXIEN=PXFLTRVAL
. I 'PXIEN Q
. I '$D(^PXV(PXFILE,PXIEN)) Q
. D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
;
I PXFLTRTYP="H" D S PXVRSLT(0)=PXCNT Q
. N PXINDEX
. S PXHL7=PXFLTRVAL
. I PXHL7="" Q
. S PXINDEX="H"
. I PXFILE=920.3 S PXINDEX="B"
. S PXIEN=$O(^PXV(PXFILE,PXINDEX,PXHL7,0))
. D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
;
I PXFLTRTYP="N" D S PXVRSLT(0)=PXCNT Q
. S PXNAME=PXFLTRVAL
. I PXNAME="" Q
. S PXIEN=$O(^PXV(PXFILE,"B",PXNAME,0))
. D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
;
; I PXFLTRTYP="S" D
I $E($G(PXFLTRVAL),1)?1(1"A",1"I",1"B") S PXFLTRSTAT=$E(PXFLTRVAL,1)
;
; Sort entries based off the order defined in the parameter
I PXFILE=920.1 D
. D GETLST^XPAR(.PXSEQARR,"ALL","PXV INFO SOURCE SEQUENCE","Q")
. S PXI=0 F S PXI=$O(PXSEQARR(PXI)) Q:'PXI D
. . S PXIEN=$P($G(PXSEQARR(PXI)),U,2)
. . I 'PXIEN Q
. . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,"",.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
. . S PXSKIP(PXFILE,PXIEN)=""
;
; Sort remaining entries in alphabetical order
S PXNAME=""
F S PXNAME=$O(^PXV(PXFILE,"B",PXNAME)) Q:PXNAME="" D
. S PXIEN=0
. F S PXIEN=$O(^PXV(PXFILE,"B",PXNAME,PXIEN)) Q:'PXIEN D
. . I PXFILE=920.3,$G(^PXV(PXFILE,"B",PXNAME,PXIEN))=1 Q ; cross-ref is on HL7 code - not .01
. . I $D(PXSKIP(PXFILE,PXIEN)) Q
. . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
;
S PXVRSLT(0)=PXCNT
;
Q
;
ADDENTRY(PXVRSLT,PXFILE,PXIEN,PXVSITES,PXFLTRSTAT,PXFLTRVAL,PXCNT) ; Adds entry to PXVRSLT
;
N PXFLDS,PXSTAT
;
I 'PXIEN Q
;
I PXFILE=920.1,$E($G(PXFLTRVAL),2)="A",$P($G(^PXV(PXFILE,PXIEN,0)),U,2)'="00" Q
I PXFILE=920.1,$E($G(PXFLTRVAL),2)="H",$P($G(^PXV(PXFILE,PXIEN,0)),U,2)="00" Q
;
S PXFLDS=$$GETFLDS(PXFILE,PXIEN)
S PXSTAT=$P(PXFLDS,U,4)
;
I $G(PXFLTRSTAT)="A",'PXSTAT Q
I $G(PXFLTRSTAT)="I",PXSTAT Q
;
S PXCNT=PXCNT+1
S PXVRSLT(PXCNT)=PXFLDS
I PXFILE=920.2,$G(PXVSITES) D ADDSITES(.PXVRSLT,.PXCNT,.PXIEN)
;
Q
;
GETFLDS(PXFILE,PXIEN) ; Returns field values
;
N PXNAME,PXHL7,PXVRSLT,PXSTAT
;
S PXNAME=$P($G(^PXV(PXFILE,PXIEN,0)),U,1)
S PXHL7=$P($G(^PXV(PXFILE,PXIEN,0)),U,2)
S PXSTAT=$$GETSTAT(PXFILE,PXIEN)
;
S PXVRSLT=PXIEN_U_PXNAME_U_PXHL7_U_PXSTAT
;
Q PXVRSLT
;
ADDSITES(PXVRSLT,PXCNT,PXROUTE) ; Add Sites to PXVRSLT
;
N PXSITE,PXSITES
;
D SITES^PXAPIIM(.PXSITES,PXROUTE,"R")
;
S PXSITE=""
F S PXSITE=$O(PXSITES(PXSITE)) Q:PXSITE="" D
. S PXCNT=PXCNT+1
. S PXVRSLT(PXCNT)="SITE^"_PXSITE
;
Q
;
GETSTAT(PXFILE,PXIEN) ;
;
N PXSTAT
;
I PXFILE?1(1"920.1",1"920.4") D Q PXSTAT
. S PXSTAT='$P($G(^PXV(PXFILE,PXIEN,0)),U,3)
;
S PXSTAT=$G(^XTMP("PXVCACHE-"_PXFILE,PXIEN))
I PXSTAT="" S PXSTAT=$P($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
I PXSTAT="" S PXSTAT=1
Q PXSTAT
;
CHKCACHE(PXFILE) ; Check Cache - see if we need to update
;
N PXCACHEDT,PXLASTEDITDT
;
I PXFILE?1(1"920.1",1"920.4") Q
;
S PXLASTEDITDT=$O(^DIA(PXFILE,"C",""),-1) ;ICR #2602
S PXCACHEDT=$P($G(^XTMP("PXVCACHE-"_PXFILE,0)),U,2)
I PXCACHEDT,PXCACHEDT>PXLASTEDITDT Q
D UPDCACHE(PXFILE)
;
Q
;
UPDCACHE(PXFILE) ;
;
N PXIEN,PXSTAT
;
K ^XTMP("PXVCACHE-"_PXFILE)
S ^XTMP("PXVCACHE-"_PXFILE,0)=$$FMADD^XLFDT(DT,730)_U_$$NOW^XLFDT()_U_"Cache status for file #"_PXFILE
S PXIEN=0
F S PXIEN=$O(^PXV(PXFILE,PXIEN)) Q:'PXIEN D
. S PXSTAT=$P($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
. I PXSTAT="" S PXSTAT=1
. S ^XTMP("PXVCACHE-"_PXFILE,PXIEN)=PXSTAT
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVRPC2 6914 printed Sep 23, 2025@20:07:59 Page 2
PXVRPC2 ;BPFO/LMT - PCE RPCs for IMM Source, Route, Site ;Jun 04, 2019@12:16:35
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**215,217**;Aug 12, 1996;Build 134
+2 ;
+3 ; Reference to ^DIA(920.X,"C") supported by ICR #2602
+4 ;
+5 ;************************************************************************
+6 ;
+7 ;Input:
+8 ; PXVRSLT - (Required) Return value
+9 ; PXVFLTR - (Optional; Defaults to "S:B") Filter. Possible values are:
+10 ; R:XXX - Return entry with IEN XXX.
+11 ; H:XXX - Return entry with HL7 Code XXX.
+12 ; N:XXX - Return entry with #.01 field equal to XXX
+13 ; S:XY - Return all entries with a status of X.
+14 ; Possible values of X:
+15 ; A - Active Entries
+16 ; I - Inactive Entries
+17 ; B - Both active and inactive entries
+18 ; Possible values of Y (only applies to file 920.1):
+19 ; A - VA-Administered
+20 ; H - Historical
+21 ;
+22 ;Returns:
+23 ; PXVRSLT(0)=Count of elements returned (0 if nothing found)
+24 ; PXVRSLT(n)=IEN^Name^HL7 Code^Status (1:Active, 0:Inactive)
+25 ;
+26 ; For the IMMROUTE tag, see additional input and return values documented below.
+27 ;
+28 ; When filtering based off IEN, HL7 Code, or #.01 field, only one entry will be returned
+29 ; in PXVRSLT(1).
+30 ;
+31 ; When filtering based off status, multiple entries can be returned. The first entry will be
+32 ; returned in subscript 1, and subscripts will be incremented by 1 for further entries.
+33 ; Entries will be sorted alphabetically.
+34 ;
+35 ; If no entries are found based off the filtering criteria, PXVRSLT(0) will equal 0,
+36 ; and there will be no data returned in the subsequent subscripts.
+37 ;
+38 ;******************************************************************************
+39 ;
IMMSRC(PXVRSLT,PXVFLTR) ;
+1 DO GETDATA(.PXVRSLT,920.1,$GET(PXVFLTR),"")
+2 QUIT
+3 ;
IMMROUTE(PXVRSLT,PXVFLTR,PXVSITES) ;
+1 ; The following additional Input and Return values are available for IMMROUTE:
+2 ; Input:
+3 ; PXVSITES - (Optional) Controls if the available sites for a give route are returned
+4 ; Returns:
+5 ; If PXVSITES=1, the sites for a given route will be returned.
+6 ; o if If only a subset of sites are selectable for a route,
+7 ; that list will be returned in
+8 ; PXVRSLT(n+1)=SITE^Site IEN 1
+9 ; PXVRSLT(n+2)=SITE^Site IEN 2
+10 ; PXVRSLT(n+x)=SITE^Site IEN x
+11 ; o if all sites are selectable for a route, the RPC will return:
+12 ; PXVRSLT(n+1)=SITE^ALL
+13 ; o If no sites are selectable for a route, the RPC will return:
+14 ; PXVRSLT(n+1)=SITE^NONE
+15 ;
+16 DO GETDATA(.PXVRSLT,920.2,$GET(PXVFLTR),$GET(PXVSITES))
+17 QUIT
+18 ;
IMMSITE(PXVRSLT,PXVFLTR,PXVDATE) ;
+1 DO GETDATA(.PXVRSLT,920.3,$GET(PXVFLTR),"")
+2 QUIT
+3 ;
+4 ;************************************************************************
+5 ;
GETDATA(PXVRSLT,PXFILE,PXVFLTR,PXVSITES) ;
+1 ;
+2 NEW PXCNT,PXI,PXIEN,PXHL7,PXFKTRSTAT,PXFLTRTYP,PXFLTRVAL,PXFLTRSTAT,PXNAME,PXFLDS,PXSEQARR,PXSKIP,PXSTAT
+3 SET PXCNT=0
+4 SET PXIEN=""
+5 SET PXHL7=""
+6 SET PXFLTRTYP="S"
+7 SET PXFLTRSTAT="B"
+8 DO CHKCACHE(PXFILE)
+9 ;
+10 IF $GET(PXVFLTR)'=""
Begin DoDot:1
+11 SET PXFLTRTYP=$PIECE(PXVFLTR,":",1)
+12 SET PXFLTRVAL=$PIECE(PXVFLTR,":",2)
End DoDot:1
+13 ;
+14 IF PXFLTRTYP="R"
Begin DoDot:1
+15 SET PXIEN=PXFLTRVAL
+16 IF 'PXIEN
QUIT
+17 IF '$DATA(^PXV(PXFILE,PXIEN))
QUIT
+18 DO ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$GET(PXVSITES),"","",.PXCNT)
End DoDot:1
SET PXVRSLT(0)=PXCNT
QUIT
+19 ;
+20 IF PXFLTRTYP="H"
Begin DoDot:1
+21 NEW PXINDEX
+22 SET PXHL7=PXFLTRVAL
+23 IF PXHL7=""
QUIT
+24 SET PXINDEX="H"
+25 IF PXFILE=920.3
SET PXINDEX="B"
+26 SET PXIEN=$ORDER(^PXV(PXFILE,PXINDEX,PXHL7,0))
+27 DO ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$GET(PXVSITES),"","",.PXCNT)
End DoDot:1
SET PXVRSLT(0)=PXCNT
QUIT
+28 ;
+29 IF PXFLTRTYP="N"
Begin DoDot:1
+30 SET PXNAME=PXFLTRVAL
+31 IF PXNAME=""
QUIT
+32 SET PXIEN=$ORDER(^PXV(PXFILE,"B",PXNAME,0))
+33 DO ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$GET(PXVSITES),"","",.PXCNT)
End DoDot:1
SET PXVRSLT(0)=PXCNT
QUIT
+34 ;
+35 ; I PXFLTRTYP="S" D
+36 IF $EXTRACT($GET(PXFLTRVAL),1)?1(1"A",1"I",1"B")
SET PXFLTRSTAT=$EXTRACT(PXFLTRVAL,1)
+37 ;
+38 ; Sort entries based off the order defined in the parameter
+39 IF PXFILE=920.1
Begin DoDot:1
+40 DO GETLST^XPAR(.PXSEQARR,"ALL","PXV INFO SOURCE SEQUENCE","Q")
+41 SET PXI=0
FOR
SET PXI=$ORDER(PXSEQARR(PXI))
if 'PXI
QUIT
Begin DoDot:2
+42 SET PXIEN=$PIECE($GET(PXSEQARR(PXI)),U,2)
+43 IF 'PXIEN
QUIT
+44 DO ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,"",.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
+45 SET PXSKIP(PXFILE,PXIEN)=""
End DoDot:2
End DoDot:1
+46 ;
+47 ; Sort remaining entries in alphabetical order
+48 SET PXNAME=""
+49 FOR
SET PXNAME=$ORDER(^PXV(PXFILE,"B",PXNAME))
if PXNAME=""
QUIT
Begin DoDot:1
+50 SET PXIEN=0
+51 FOR
SET PXIEN=$ORDER(^PXV(PXFILE,"B",PXNAME,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:2
+52 ; cross-ref is on HL7 code - not .01
IF PXFILE=920.3
IF $GET(^PXV(PXFILE,"B",PXNAME,PXIEN))=1
QUIT
+53 IF $DATA(PXSKIP(PXFILE,PXIEN))
QUIT
+54 DO ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$GET(PXVSITES),.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
End DoDot:2
End DoDot:1
+55 ;
+56 SET PXVRSLT(0)=PXCNT
+57 ;
+58 QUIT
+59 ;
ADDENTRY(PXVRSLT,PXFILE,PXIEN,PXVSITES,PXFLTRSTAT,PXFLTRVAL,PXCNT) ; Adds entry to PXVRSLT
+1 ;
+2 NEW PXFLDS,PXSTAT
+3 ;
+4 IF 'PXIEN
QUIT
+5 ;
+6 IF PXFILE=920.1
IF $EXTRACT($GET(PXFLTRVAL),2)="A"
IF $PIECE($GET(^PXV(PXFILE,PXIEN,0)),U,2)'="00"
QUIT
+7 IF PXFILE=920.1
IF $EXTRACT($GET(PXFLTRVAL),2)="H"
IF $PIECE($GET(^PXV(PXFILE,PXIEN,0)),U,2)="00"
QUIT
+8 ;
+9 SET PXFLDS=$$GETFLDS(PXFILE,PXIEN)
+10 SET PXSTAT=$PIECE(PXFLDS,U,4)
+11 ;
+12 IF $GET(PXFLTRSTAT)="A"
IF 'PXSTAT
QUIT
+13 IF $GET(PXFLTRSTAT)="I"
IF PXSTAT
QUIT
+14 ;
+15 SET PXCNT=PXCNT+1
+16 SET PXVRSLT(PXCNT)=PXFLDS
+17 IF PXFILE=920.2
IF $GET(PXVSITES)
DO ADDSITES(.PXVRSLT,.PXCNT,.PXIEN)
+18 ;
+19 QUIT
+20 ;
GETFLDS(PXFILE,PXIEN) ; Returns field values
+1 ;
+2 NEW PXNAME,PXHL7,PXVRSLT,PXSTAT
+3 ;
+4 SET PXNAME=$PIECE($GET(^PXV(PXFILE,PXIEN,0)),U,1)
+5 SET PXHL7=$PIECE($GET(^PXV(PXFILE,PXIEN,0)),U,2)
+6 SET PXSTAT=$$GETSTAT(PXFILE,PXIEN)
+7 ;
+8 SET PXVRSLT=PXIEN_U_PXNAME_U_PXHL7_U_PXSTAT
+9 ;
+10 QUIT PXVRSLT
+11 ;
ADDSITES(PXVRSLT,PXCNT,PXROUTE) ; Add Sites to PXVRSLT
+1 ;
+2 NEW PXSITE,PXSITES
+3 ;
+4 DO SITES^PXAPIIM(.PXSITES,PXROUTE,"R")
+5 ;
+6 SET PXSITE=""
+7 FOR
SET PXSITE=$ORDER(PXSITES(PXSITE))
if PXSITE=""
QUIT
Begin DoDot:1
+8 SET PXCNT=PXCNT+1
+9 SET PXVRSLT(PXCNT)="SITE^"_PXSITE
End DoDot:1
+10 ;
+11 QUIT
+12 ;
GETSTAT(PXFILE,PXIEN) ;
+1 ;
+2 NEW PXSTAT
+3 ;
+4 IF PXFILE?1(1"920.1",1"920.4")
Begin DoDot:1
+5 SET PXSTAT='$PIECE($GET(^PXV(PXFILE,PXIEN,0)),U,3)
End DoDot:1
QUIT PXSTAT
+6 ;
+7 SET PXSTAT=$GET(^XTMP("PXVCACHE-"_PXFILE,PXIEN))
+8 IF PXSTAT=""
SET PXSTAT=$PIECE($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
+9 IF PXSTAT=""
SET PXSTAT=1
+10 QUIT PXSTAT
+11 ;
CHKCACHE(PXFILE) ; Check Cache - see if we need to update
+1 ;
+2 NEW PXCACHEDT,PXLASTEDITDT
+3 ;
+4 IF PXFILE?1(1"920.1",1"920.4")
QUIT
+5 ;
+6 ;ICR #2602
SET PXLASTEDITDT=$ORDER(^DIA(PXFILE,"C",""),-1)
+7 SET PXCACHEDT=$PIECE($GET(^XTMP("PXVCACHE-"_PXFILE,0)),U,2)
+8 IF PXCACHEDT
IF PXCACHEDT>PXLASTEDITDT
QUIT
+9 DO UPDCACHE(PXFILE)
+10 ;
+11 QUIT
+12 ;
UPDCACHE(PXFILE) ;
+1 ;
+2 NEW PXIEN,PXSTAT
+3 ;
+4 KILL ^XTMP("PXVCACHE-"_PXFILE)
+5 SET ^XTMP("PXVCACHE-"_PXFILE,0)=$$FMADD^XLFDT(DT,730)_U_$$NOW^XLFDT()_U_"Cache status for file #"_PXFILE
+6 SET PXIEN=0
+7 FOR
SET PXIEN=$ORDER(^PXV(PXFILE,PXIEN))
if 'PXIEN
QUIT
Begin DoDot:1
+8 SET PXSTAT=$PIECE($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
+9 IF PXSTAT=""
SET PXSTAT=1
+10 SET ^XTMP("PXVCACHE-"_PXFILE,PXIEN)=PXSTAT
End DoDot:1
+11 ;
+12 QUIT
