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

PXVRPC2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Reference to ^DIA(920.X,"C") supported by ICR #2602
  1.  ;
  1.  ;************************************************************************
  1.  ;
  1.  ;Input:
  1.  ;  PXVRSLT - (Required) Return value
  1.  ;  PXVFLTR - (Optional; Defaults to "S:B") Filter. Possible values are:
  1.  ;               R:XXX - Return entry with IEN XXX.
  1.  ;               H:XXX - Return entry with HL7 Code XXX.
  1.  ;               N:XXX - Return entry with #.01 field equal to XXX
  1.  ;               S:XY  - Return all entries with a status of X.
  1.  ;                       Possible values of X:
  1.  ;                         A - Active Entries
  1.  ;                         I - Inactive Entries
  1.  ;                         B - Both active and inactive entries
  1.  ;                       Possible values of Y (only applies to file 920.1):
  1.  ;                         A - VA-Administered
  1.  ;                         H - Historical
  1.  ;
  1.  ;Returns:
  1.  ; PXVRSLT(0)=Count of elements returned (0 if nothing found)
  1.  ; PXVRSLT(n)=IEN^Name^HL7 Code^Status (1:Active, 0:Inactive)
  1.  ;
  1.  ; For the IMMROUTE tag, see additional input and return values documented below.
  1.  ;
  1.  ; When filtering based off IEN, HL7 Code, or #.01 field, only one entry will be returned
  1.  ; in PXVRSLT(1).
  1.  ;
  1.  ; When filtering based off status, multiple entries can be returned. The first entry will be
  1.  ; returned in subscript 1, and subscripts will be incremented by 1 for further entries.
  1.  ; Entries will be sorted alphabetically.
  1.  ;
  1.  ; If no entries are found based off the filtering criteria, PXVRSLT(0) will equal 0,
  1.  ; and there will be no data returned in the subsequent subscripts.
  1.  ;
  1.  ;******************************************************************************
  1.  ;
  1. IMMSRC(PXVRSLT,PXVFLTR) ;
  1.  D GETDATA(.PXVRSLT,920.1,$G(PXVFLTR),"")
  1.  Q
  1.  ;
  1. IMMROUTE(PXVRSLT,PXVFLTR,PXVSITES) ;
  1.  ; The following additional Input and Return values are available for IMMROUTE:
  1.  ;   Input:
  1.  ;      PXVSITES - (Optional) Controls if the available sites for a give route are returned
  1.  ;   Returns:
  1.  ;      If PXVSITES=1, the sites for a given route will be returned.
  1.  ;       o if If only a subset of sites are selectable for a route,
  1.  ;         that list will be returned in
  1.  ;           PXVRSLT(n+1)=SITE^Site IEN 1
  1.  ;           PXVRSLT(n+2)=SITE^Site IEN 2
  1.  ;           PXVRSLT(n+x)=SITE^Site IEN x
  1.  ;       o if all sites are selectable for a route, the RPC will return:
  1.  ;           PXVRSLT(n+1)=SITE^ALL
  1.  ;       o If no sites are selectable for a route, the RPC will return:
  1.  ;           PXVRSLT(n+1)=SITE^NONE
  1.  ;
  1.  D GETDATA(.PXVRSLT,920.2,$G(PXVFLTR),$G(PXVSITES))
  1.  Q
  1.  ;
  1. IMMSITE(PXVRSLT,PXVFLTR,PXVDATE) ;
  1.  D GETDATA(.PXVRSLT,920.3,$G(PXVFLTR),"")
  1.  Q
  1.  ;
  1.  ;************************************************************************
  1.  ;
  1. GETDATA(PXVRSLT,PXFILE,PXVFLTR,PXVSITES) ;
  1.  ;
  1.  N PXCNT,PXI,PXIEN,PXHL7,PXFKTRSTAT,PXFLTRTYP,PXFLTRVAL,PXFLTRSTAT,PXNAME,PXFLDS,PXSEQARR,PXSKIP,PXSTAT
  1.  S PXCNT=0
  1.  S PXIEN=""
  1.  S PXHL7=""
  1.  S PXFLTRTYP="S"
  1.  S PXFLTRSTAT="B"
  1.  D CHKCACHE(PXFILE)
  1.  ;
  1.  I $G(PXVFLTR)'="" D
  1.  . S PXFLTRTYP=$P(PXVFLTR,":",1)
  1.  . S PXFLTRVAL=$P(PXVFLTR,":",2)
  1.  ;
  1.  I PXFLTRTYP="R" D  S PXVRSLT(0)=PXCNT Q
  1.  . S PXIEN=PXFLTRVAL
  1.  . I 'PXIEN Q
  1.  . I '$D(^PXV(PXFILE,PXIEN)) Q
  1.  . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
  1.  ;
  1.  I PXFLTRTYP="H" D  S PXVRSLT(0)=PXCNT Q
  1.  . N PXINDEX
  1.  . S PXHL7=PXFLTRVAL
  1.  . I PXHL7="" Q
  1.  . S PXINDEX="H"
  1.  . I PXFILE=920.3 S PXINDEX="B"
  1.  . S PXIEN=$O(^PXV(PXFILE,PXINDEX,PXHL7,0))
  1.  . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
  1.  ;
  1.  I PXFLTRTYP="N" D  S PXVRSLT(0)=PXCNT Q
  1.  . S PXNAME=PXFLTRVAL
  1.  . I PXNAME="" Q
  1.  . S PXIEN=$O(^PXV(PXFILE,"B",PXNAME,0))
  1.  . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),"","",.PXCNT)
  1.  ;
  1.  ; I PXFLTRTYP="S" D
  1.  I $E($G(PXFLTRVAL),1)?1(1"A",1"I",1"B") S PXFLTRSTAT=$E(PXFLTRVAL,1)
  1.  ;
  1.  ; Sort entries based off the order defined in the parameter
  1.  I PXFILE=920.1 D
  1.  . D GETLST^XPAR(.PXSEQARR,"ALL","PXV INFO SOURCE SEQUENCE","Q")
  1.  . S PXI=0 F  S PXI=$O(PXSEQARR(PXI)) Q:'PXI  D
  1.  . . S PXIEN=$P($G(PXSEQARR(PXI)),U,2)
  1.  . . I 'PXIEN Q
  1.  . . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,"",.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
  1.  . . S PXSKIP(PXFILE,PXIEN)=""
  1.  ;
  1.  ; Sort remaining entries in alphabetical order
  1.  S PXNAME=""
  1.  F  S PXNAME=$O(^PXV(PXFILE,"B",PXNAME)) Q:PXNAME=""  D
  1.  . S PXIEN=0
  1.  . F  S PXIEN=$O(^PXV(PXFILE,"B",PXNAME,PXIEN)) Q:'PXIEN  D
  1.  . . I PXFILE=920.3,$G(^PXV(PXFILE,"B",PXNAME,PXIEN))=1 Q  ; cross-ref is on HL7 code - not .01
  1.  . . I $D(PXSKIP(PXFILE,PXIEN)) Q
  1.  . . D ADDENTRY(.PXVRSLT,.PXFILE,.PXIEN,$G(PXVSITES),.PXFLTRSTAT,.PXFLTRVAL,.PXCNT)
  1.  ;
  1.  S PXVRSLT(0)=PXCNT
  1.  ;
  1.  Q
  1.  ;
  1. ADDENTRY(PXVRSLT,PXFILE,PXIEN,PXVSITES,PXFLTRSTAT,PXFLTRVAL,PXCNT) ; Adds entry to PXVRSLT
  1.  ;
  1.  N PXFLDS,PXSTAT
  1.  ;
  1.  I 'PXIEN Q
  1.  ;
  1.  I PXFILE=920.1,$E($G(PXFLTRVAL),2)="A",$P($G(^PXV(PXFILE,PXIEN,0)),U,2)'="00" Q
  1.  I PXFILE=920.1,$E($G(PXFLTRVAL),2)="H",$P($G(^PXV(PXFILE,PXIEN,0)),U,2)="00" Q
  1.  ;
  1.  S PXFLDS=$$GETFLDS(PXFILE,PXIEN)
  1.  S PXSTAT=$P(PXFLDS,U,4)
  1.  ;
  1.  I $G(PXFLTRSTAT)="A",'PXSTAT Q
  1.  I $G(PXFLTRSTAT)="I",PXSTAT Q
  1.  ;
  1.  S PXCNT=PXCNT+1
  1.  S PXVRSLT(PXCNT)=PXFLDS
  1.  I PXFILE=920.2,$G(PXVSITES) D ADDSITES(.PXVRSLT,.PXCNT,.PXIEN)
  1.  ;
  1.  Q
  1.  ;
  1. GETFLDS(PXFILE,PXIEN) ; Returns field values
  1.  ;
  1.  N PXNAME,PXHL7,PXVRSLT,PXSTAT
  1.  ;
  1.  S PXNAME=$P($G(^PXV(PXFILE,PXIEN,0)),U,1)
  1.  S PXHL7=$P($G(^PXV(PXFILE,PXIEN,0)),U,2)
  1.  S PXSTAT=$$GETSTAT(PXFILE,PXIEN)
  1.  ;
  1.  S PXVRSLT=PXIEN_U_PXNAME_U_PXHL7_U_PXSTAT
  1.  ;
  1.  Q PXVRSLT
  1.  ;
  1. ADDSITES(PXVRSLT,PXCNT,PXROUTE) ; Add Sites to PXVRSLT
  1.  ;
  1.  N PXSITE,PXSITES
  1.  ;
  1.  D SITES^PXAPIIM(.PXSITES,PXROUTE,"R")
  1.  ;
  1.  S PXSITE=""
  1.  F  S PXSITE=$O(PXSITES(PXSITE)) Q:PXSITE=""  D
  1.  . S PXCNT=PXCNT+1
  1.  . S PXVRSLT(PXCNT)="SITE^"_PXSITE
  1.  ;
  1.  Q
  1.  ;
  1. GETSTAT(PXFILE,PXIEN) ;
  1.  ;
  1.  N PXSTAT
  1.  ;
  1.  I PXFILE?1(1"920.1",1"920.4") D  Q PXSTAT
  1.  . S PXSTAT='$P($G(^PXV(PXFILE,PXIEN,0)),U,3)
  1.  ;
  1.  S PXSTAT=$G(^XTMP("PXVCACHE-"_PXFILE,PXIEN))
  1.  I PXSTAT="" S PXSTAT=$P($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
  1.  I PXSTAT="" S PXSTAT=1
  1.  Q PXSTAT
  1.  ;
  1. CHKCACHE(PXFILE) ; Check Cache - see if we need to update
  1.  ;
  1.  N PXCACHEDT,PXLASTEDITDT
  1.  ;
  1.  I PXFILE?1(1"920.1",1"920.4") Q
  1.  ;
  1.  S PXLASTEDITDT=$O(^DIA(PXFILE,"C",""),-1)   ;ICR #2602
  1.  S PXCACHEDT=$P($G(^XTMP("PXVCACHE-"_PXFILE,0)),U,2)
  1.  I PXCACHEDT,PXCACHEDT>PXLASTEDITDT Q
  1.  D UPDCACHE(PXFILE)
  1.  ;
  1.  Q
  1.  ;
  1. UPDCACHE(PXFILE) ;
  1.  ;
  1.  N PXIEN,PXSTAT
  1.  ;
  1.  K ^XTMP("PXVCACHE-"_PXFILE)
  1.  S ^XTMP("PXVCACHE-"_PXFILE,0)=$$FMADD^XLFDT(DT,730)_U_$$NOW^XLFDT()_U_"Cache status for file #"_PXFILE
  1.  S PXIEN=0
  1.  F  S PXIEN=$O(^PXV(PXFILE,PXIEN)) Q:'PXIEN  D
  1.  . S PXSTAT=$P($$GETSTAT^XTID(PXFILE,"",PXIEN_","),U,1)
  1.  . I PXSTAT="" S PXSTAT=1
  1.  . S ^XTMP("PXVCACHE-"_PXFILE,PXIEN)=PXSTAT
  1.  ;
  1.  Q