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

PXKENC.m

Go to the documentation of this file. 
  1. PXKENC ;ISL/dee,ESW - Builds the array of all encounter data for the event point ; 12/5/02 11:53am
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,22,73,108**;Aug 12, 1996
  1.  Q
  1.  ;
  1. GETENC(DFN,ENCDT,HLOC) ;Get all of the encounter data
  1.  ;Parameters:
  1.  ;  DFN    Pointer to the patient (#9000001)
  1.  ;  ENCDT  Date/Time of the encounter in Fileman format
  1.  ;  HLOC   Pointer to Hospital Location (#44)
  1.  ;
  1.  ;Returns:
  1.  ;  -2  if called incorrectly
  1.  ;  -1  if could not find encounter
  1.  ;  >0  Visit ien(s) separated by ^
  1.  ;
  1.  ;  The encounter is returned in the array
  1.  ;    ^TMP("PXKENC",$J,pointer to visit)
  1.  ;  may contain more than one visit
  1.  ;
  1.  N VISITIEN,REVDT,RETURN
  1.  K ^TMP("PXKENC",$J)
  1.  S RETURN=-1
  1.  Q:DFN'>0!(ENCDT<1800000)!(HLOC'>0) -2
  1.  S REVDT=(9999999-$P(+ENCDT,".",1))_$S($P(+ENCDT,".",2)'="":"."_$P(+ENCDT,".",2),1:"")
  1.  S VISITIEN=0
  1.  F  S VISITIEN=$O(^AUPNVSIT("AA",+DFN,REVDT,VISITIEN)) Q:'VISITIEN  D
  1.  . I $P($G(^AUPNVSIT(VISITIEN,0)),"^",22)=HLOC,"C~S"'[$P($G(^AUPNVSIT(VISITIEN,150)),"^",3) D
  1.  .. D ENCEVENT(VISITIEN,1)
  1.  .. I RETURN<1 S RETURN=VISITIEN
  1.  .. E  S RETURN=RETURN_"^"_VISITIEN
  1.  Q RETURN
  1.  ;
  1. ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PXKENC",$J, array of all the
  1.  ;  information about one encounter.
  1.  ;Parameters:
  1.  ;  VISITIEN  Pointer to the Visit (#9000010)
  1.  ;  DONOTKILL is 1 if the output array is not to be killed before used
  1.  ;            and 0 or null if the array is to be killed (cleaned out)
  1.  ;
  1.  ;  The encounter is returned in the array
  1.  ;    ^TMP("PXKENC",$J,pointer to visit)
  1.  ;
  1.  I '$D(^AUPNVSIT(VISITIEN)) Q
  1.  K:'$G(DONTKILL) ^TMP("PXKENC",$J)
  1.  N PXKCNT,PXKROOT
  1.  S PXKROOT=$NA(@("^TMP(""PXKENC"",$J,"_VISITIEN_")"))
  1.  ;
  1.  N IEN,FILE,VFILE,FILESTR,PXKNODE
  1.  F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
  1.  . S FILESTR=$S(FILE="SIT":"VST",1:FILE)
  1.  . S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="SIT":"VST",FILE="CSTP":"VST",1:FILE))),";;",2)
  1.  . I FILE="SIT" D
  1.  .. S IEN=VISITIEN
  1.  .. S PXKNODE=""
  1.  .. F  S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE=""  D
  1.  ... S @PXKROOT@(FILESTR,IEN,PXKNODE)=@VFILE@(IEN,PXKNODE)
  1.  . E  D
  1.  .. I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILESTR)
  1.  .. I FILE'="PRV" S IEN="" F  S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN  D
  1.  ... I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
  1.  ... S PXKNODE=""
  1.  ... F  S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE=""  D:PXKNODE'=801
  1.  .... ;for cpt modifiers
  1.  .... I FILE="CPT",PXKNODE=1 D  Q
  1.  ..... S @PXKROOT@(FILESTR,IEN,PXKNODE,0)=$G(@VFILE@(IEN,PXKNODE,0))
  1.  ..... N SUBIEN
  1.  ..... S SUBIEN=0
  1.  ..... F  S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:SUBIEN=""  D
  1.  ...... S @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$G(@VFILE@(IEN,PXKNODE,SUBIEN,0))
  1.  .... ;
  1.  .... S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
  1.  Q
  1. EVALD(VISITIEN,PXKROOT,VFILE,FILESTR) ;evaluation for duplicate providers
  1.  N CNT,PR,PRS,PS,PP,PRV,STR
  1.  S IEN="",CNT=0
  1.  F  S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN  D
  1.  .S STR=@VFILE@(IEN,0),PR=+STR,PS=$P(STR,U,4)
  1.  .I PS="P",'CNT S PRV=PR,CNT=1 D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
  1.  .I PS="S" S PRS(PR,IEN)="" D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
  1.  .Q
  1.  S PR="" F  S PR=$O(PRS(PR)) Q:PR=""  S IEN="" D
  1.  .F PP=1:1 S IEN=$O(PRS(PR,IEN)) Q:IEN=""  D
  1.  ..I PR=$G(PRV) K @PXKROOT@(FILESTR,IEN) Q
  1.  ..I PP>1 K @PXKROOT@(FILESTR,IEN)
  1.  Q
  1. PXKNODE(VFILE,FILESTR,IEN,PXKROOT) ;
  1.  N STRR S PXKNODE=""
  1.  F  S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE=""  D:PXKNODE'=801
  1.  . I $E($P($P(PXKROOT,","),"(",2),2,7)="PXKENC" D
  1.  ..; ENCEVENT called
  1.  .. S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
  1.  . E  I $E($P($P(PXKROOT,","),"(",2),2,6)="PXKCO" D
  1.  ..; COEVENT called
  1.  .. F STRR="BEFORE","AFTER" D
  1.  ... S @PXKROOT@(FILESTR,IEN,PXKNODE,STRR)=$G(@VFILE@(IEN,PXKNODE))
  1.  Q
  1.  ;
  1. COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array all of the
  1.  ;   information that is not already there.
  1.  I '$D(^AUPNVSIT(VISITIEN)) Q
  1.  N PXKCNT,PXKROOT
  1.  S PXKROOT=$NA(@("^TMP(""PXKCO"",$J,"_VISITIEN_")"))
  1.  ;
  1.  N IEN,FILE,VFILE,PXKNODE
  1.  F FILE="CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
  1.  . S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="CSTP":"VST",1:FILE))),";;",2)
  1.  . I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILE)
  1.  . I FILE'="PRV" S IEN="" F  S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN  D
  1.  .. I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
  1.  .. S PXKNODE=""
  1.  .. I '$D(@PXKROOT@(FILE,IEN)) D
  1.  ... F  S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE=""  D:PXKNODE'=801
  1.  .... I FILE="CPT",PXKNODE=1 D  Q
  1.  ..... N SUBIEN,MOD
  1.  ..... S SUBIEN=0
  1.  ..... F  S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:'SUBIEN  D
  1.  ...... S MOD=@VFILE@(IEN,PXKNODE,SUBIEN,0)
  1.  ...... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",MOD)=""
  1.  ...... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",MOD)=""
  1.  .... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE")=$G(@VFILE@(IEN,PXKNODE))
  1.  .... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER")=$G(@VFILE@(IEN,PXKNODE))
  1.  Q
  1.  ;