PXKENC ;ISL/dee,ESW - Builds the array of all encounter data for the event point ; 12/5/02 11:53am
;;1.0;PCE PATIENT CARE ENCOUNTER;**15,22,73,108**;Aug 12, 1996
Q
;
GETENC(DFN,ENCDT,HLOC) ;Get all of the encounter data
;Parameters:
; DFN Pointer to the patient (#9000001)
; ENCDT Date/Time of the encounter in Fileman format
; HLOC Pointer to Hospital Location (#44)
;
;Returns:
; -2 if called incorrectly
; -1 if could not find encounter
; >0 Visit ien(s) separated by ^
;
; The encounter is returned in the array
; ^TMP("PXKENC",$J,pointer to visit)
; may contain more than one visit
;
N VISITIEN,REVDT,RETURN
K ^TMP("PXKENC",$J)
S RETURN=-1
Q:DFN'>0!(ENCDT<1800000)!(HLOC'>0) -2
S REVDT=(9999999-$P(+ENCDT,".",1))_$S($P(+ENCDT,".",2)'="":"."_$P(+ENCDT,".",2),1:"")
S VISITIEN=0
F S VISITIEN=$O(^AUPNVSIT("AA",+DFN,REVDT,VISITIEN)) Q:'VISITIEN D
. I $P($G(^AUPNVSIT(VISITIEN,0)),"^",22)=HLOC,"C~S"'[$P($G(^AUPNVSIT(VISITIEN,150)),"^",3) D
.. D ENCEVENT(VISITIEN,1)
.. I RETURN<1 S RETURN=VISITIEN
.. E S RETURN=RETURN_"^"_VISITIEN
Q RETURN
;
ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PXKENC",$J, array of all the
; information about one encounter.
;Parameters:
; VISITIEN Pointer to the Visit (#9000010)
; DONOTKILL is 1 if the output array is not to be killed before used
; and 0 or null if the array is to be killed (cleaned out)
;
; The encounter is returned in the array
; ^TMP("PXKENC",$J,pointer to visit)
;
I '$D(^AUPNVSIT(VISITIEN)) Q
K:'$G(DONTKILL) ^TMP("PXKENC",$J)
N PXKCNT,PXKROOT
S PXKROOT=$NA(@("^TMP(""PXKENC"",$J,"_VISITIEN_")"))
;
N IEN,FILE,VFILE,FILESTR,PXKNODE
F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
. S FILESTR=$S(FILE="SIT":"VST",1:FILE)
. S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="SIT":"VST",FILE="CSTP":"VST",1:FILE))),";;",2)
. I FILE="SIT" D
.. S IEN=VISITIEN
.. S PXKNODE=""
.. F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D
... S @PXKROOT@(FILESTR,IEN,PXKNODE)=@VFILE@(IEN,PXKNODE)
. E D
.. I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILESTR)
.. I FILE'="PRV" S IEN="" F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
... I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
... S PXKNODE=""
... F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
.... ;for cpt modifiers
.... I FILE="CPT",PXKNODE=1 D Q
..... S @PXKROOT@(FILESTR,IEN,PXKNODE,0)=$G(@VFILE@(IEN,PXKNODE,0))
..... N SUBIEN
..... S SUBIEN=0
..... F S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:SUBIEN="" D
...... S @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$G(@VFILE@(IEN,PXKNODE,SUBIEN,0))
.... ;
.... S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
Q
EVALD(VISITIEN,PXKROOT,VFILE,FILESTR) ;evaluation for duplicate providers
N CNT,PR,PRS,PS,PP,PRV,STR
S IEN="",CNT=0
F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
.S STR=@VFILE@(IEN,0),PR=+STR,PS=$P(STR,U,4)
.I PS="P",'CNT S PRV=PR,CNT=1 D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
.I PS="S" S PRS(PR,IEN)="" D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
.Q
S PR="" F S PR=$O(PRS(PR)) Q:PR="" S IEN="" D
.F PP=1:1 S IEN=$O(PRS(PR,IEN)) Q:IEN="" D
..I PR=$G(PRV) K @PXKROOT@(FILESTR,IEN) Q
..I PP>1 K @PXKROOT@(FILESTR,IEN)
Q
PXKNODE(VFILE,FILESTR,IEN,PXKROOT) ;
N STRR S PXKNODE=""
F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
. I $E($P($P(PXKROOT,","),"(",2),2,7)="PXKENC" D
..; ENCEVENT called
.. S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
. E I $E($P($P(PXKROOT,","),"(",2),2,6)="PXKCO" D
..; COEVENT called
.. F STRR="BEFORE","AFTER" D
... S @PXKROOT@(FILESTR,IEN,PXKNODE,STRR)=$G(@VFILE@(IEN,PXKNODE))
Q
;
COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array all of the
; information that is not already there.
I '$D(^AUPNVSIT(VISITIEN)) Q
N PXKCNT,PXKROOT
S PXKROOT=$NA(@("^TMP(""PXKCO"",$J,"_VISITIEN_")"))
;
N IEN,FILE,VFILE,PXKNODE
F FILE="CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
. S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="CSTP":"VST",1:FILE))),";;",2)
. I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILE)
. I FILE'="PRV" S IEN="" F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
.. I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
.. S PXKNODE=""
.. I '$D(@PXKROOT@(FILE,IEN)) D
... F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
.... I FILE="CPT",PXKNODE=1 D Q
..... N SUBIEN,MOD
..... S SUBIEN=0
..... F S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:'SUBIEN D
...... S MOD=@VFILE@(IEN,PXKNODE,SUBIEN,0)
...... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",MOD)=""
...... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",MOD)=""
.... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE")=$G(@VFILE@(IEN,PXKNODE))
.... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER")=$G(@VFILE@(IEN,PXKNODE))
Q
;
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
+2 QUIT
+3 ;
GETENC(DFN,ENCDT,HLOC) ;Get all of the encounter data
+1 ;Parameters:
+2 ; DFN Pointer to the patient (#9000001)
+3 ; ENCDT Date/Time of the encounter in Fileman format
+4 ; HLOC Pointer to Hospital Location (#44)
+5 ;
+6 ;Returns:
+7 ; -2 if called incorrectly
+8 ; -1 if could not find encounter
+9 ; >0 Visit ien(s) separated by ^
+10 ;
+11 ; The encounter is returned in the array
+12 ; ^TMP("PXKENC",$J,pointer to visit)
+13 ; may contain more than one visit
+14 ;
+15 NEW VISITIEN,REVDT,RETURN
+16 KILL ^TMP("PXKENC",$JOB)
+17 SET RETURN=-1
+18 IF DFN'>0!(ENCDT<1800000)!(HLOC'>0)
QUIT -2
+19 SET REVDT=(9999999-$PIECE(+ENCDT,".",1))_$SELECT($PIECE(+ENCDT,".",2)'="":"."_$PIECE(+ENCDT,".",2),1:"")
+20 SET VISITIEN=0
+21 FOR
SET VISITIEN=$ORDER(^AUPNVSIT("AA",+DFN,REVDT,VISITIEN))
IF 'VISITIEN
QUIT
Begin DoDot:1
+22 IF $PIECE($GET(^AUPNVSIT(VISITIEN,0)),"^",22)=HLOC
IF "C~S"'[$PIECE($GET(^AUPNVSIT(VISITIEN,150)),"^",3)
Begin DoDot:2
+23 DO ENCEVENT(VISITIEN,1)
+24 IF RETURN<1
SET RETURN=VISITIEN
+25 IF '$TEST
SET RETURN=RETURN_"^"_VISITIEN
End DoDot:2
End DoDot:1
+26 QUIT RETURN
+27 ;
ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PXKENC",$J, array of all the
+1 ; information about one encounter.
+2 ;Parameters:
+3 ; VISITIEN Pointer to the Visit (#9000010)
+4 ; DONOTKILL is 1 if the output array is not to be killed before used
+5 ; and 0 or null if the array is to be killed (cleaned out)
+6 ;
+7 ; The encounter is returned in the array
+8 ; ^TMP("PXKENC",$J,pointer to visit)
+9 ;
+10 IF '$DATA(^AUPNVSIT(VISITIEN))
QUIT
+11 IF '$GET(DONTKILL)
KILL ^TMP("PXKENC",$JOB)
+12 NEW PXKCNT,PXKROOT
+13 SET PXKROOT=$NAME(@("^TMP(""PXKENC"",$J,"_VISITIEN_")"))
+14 ;
+15 NEW IEN,FILE,VFILE,FILESTR,PXKNODE
+16 FOR FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM"
Begin DoDot:1
+17 SET FILESTR=$SELECT(FILE="SIT":"VST",1:FILE)
+18 SET VFILE=$PIECE($TEXT(GLOBAL^@("PXKF"_$SELECT(FILE="SIT":"VST",FILE="CSTP":"VST",1:FILE))),";;",2)
+19 IF FILE="SIT"
Begin DoDot:2
+20 SET IEN=VISITIEN
+21 SET PXKNODE=""
+22 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
IF PXKNODE=""
QUIT
Begin DoDot:3
+23 SET @PXKROOT@(FILESTR,IEN,PXKNODE)=@VFILE@(IEN,PXKNODE)
End DoDot:3
End DoDot:2
+24 IF '$TEST
Begin DoDot:2
+25 IF FILE="PRV"
DO EVALD(VISITIEN,PXKROOT,VFILE,FILESTR)
+26 IF FILE'="PRV"
SET IEN=""
FOR
SET IEN=$ORDER(@VFILE@("AD",VISITIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:3
+27 IF FILE="CSTP"
IF "SC"'[$PIECE($GET(@VFILE@(IEN,150)),"^",3)
QUIT
+28 SET PXKNODE=""
+29 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
IF PXKNODE=""
QUIT
IF PXKNODE'=801
Begin DoDot:4
+30 ;for cpt modifiers
+31 IF FILE="CPT"
IF PXKNODE=1
Begin DoDot:5
+32 SET @PXKROOT@(FILESTR,IEN,PXKNODE,0)=$GET(@VFILE@(IEN,PXKNODE,0))
+33 NEW SUBIEN
+34 SET SUBIEN=0
+35 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
IF SUBIEN=""
QUIT
Begin DoDot:6
+36 SET @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$GET(@VFILE@(IEN,PXKNODE,SUBIEN,0))
End DoDot:6
End DoDot:5
QUIT
+37 ;
+38 SET @PXKROOT@(FILESTR,IEN,PXKNODE)=$GET(@VFILE@(IEN,PXKNODE))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+39 QUIT
EVALD(VISITIEN,PXKROOT,VFILE,FILESTR) ;evaluation for duplicate providers
+1 NEW CNT,PR,PRS,PS,PP,PRV,STR
+2 SET IEN=""
SET CNT=0
+3 FOR
SET IEN=$ORDER(@VFILE@("AD",VISITIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:1
+4 SET STR=@VFILE@(IEN,0)
SET PR=+STR
SET PS=$PIECE(STR,U,4)
+5 IF PS="P"
IF 'CNT
SET PRV=PR
SET CNT=1
DO PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
+6 IF PS="S"
SET PRS(PR,IEN)=""
DO PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
+7 QUIT
End DoDot:1
+8 SET PR=""
FOR
SET PR=$ORDER(PRS(PR))
IF PR=""
QUIT
SET IEN=""
Begin DoDot:1
+9 FOR PP=1:1
SET IEN=$ORDER(PRS(PR,IEN))
IF IEN=""
QUIT
Begin DoDot:2
+10 IF PR=$GET(PRV)
KILL @PXKROOT@(FILESTR,IEN)
QUIT
+11 IF PP>1
KILL @PXKROOT@(FILESTR,IEN)
End DoDot:2
End DoDot:1
+12 QUIT
PXKNODE(VFILE,FILESTR,IEN,PXKROOT) ;
+1 NEW STRR
SET PXKNODE=""
+2 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
IF PXKNODE=""
QUIT
IF PXKNODE'=801
Begin DoDot:1
+3 IF $EXTRACT($PIECE($PIECE(PXKROOT,","),"(",2),2,7)="PXKENC"
Begin DoDot:2
+4 ; ENCEVENT called
+5 SET @PXKROOT@(FILESTR,IEN,PXKNODE)=$GET(@VFILE@(IEN,PXKNODE))
End DoDot:2
+6 IF '$TEST
IF $EXTRACT($PIECE($PIECE(PXKROOT,","),"(",2),2,6)="PXKCO"
Begin DoDot:2
+7 ; COEVENT called
+8 FOR STRR="BEFORE","AFTER"
Begin DoDot:3
+9 SET @PXKROOT@(FILESTR,IEN,PXKNODE,STRR)=$GET(@VFILE@(IEN,PXKNODE))
End DoDot:3
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array all of the
+1 ; information that is not already there.
+2 IF '$DATA(^AUPNVSIT(VISITIEN))
QUIT
+3 NEW PXKCNT,PXKROOT
+4 SET PXKROOT=$NAME(@("^TMP(""PXKCO"",$J,"_VISITIEN_")"))
+5 ;
+6 NEW IEN,FILE,VFILE,PXKNODE
+7 FOR FILE="CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM"
Begin DoDot:1
+8 SET VFILE=$PIECE($TEXT(GLOBAL^@("PXKF"_$SELECT(FILE="CSTP":"VST",1:FILE))),";;",2)
+9 IF FILE="PRV"
DO EVALD(VISITIEN,PXKROOT,VFILE,FILE)
+10 IF FILE'="PRV"
SET IEN=""
FOR
SET IEN=$ORDER(@VFILE@("AD",VISITIEN,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+11 IF FILE="CSTP"
IF "SC"'[$PIECE($GET(@VFILE@(IEN,150)),"^",3)
QUIT
+12 SET PXKNODE=""
+13 IF '$DATA(@PXKROOT@(FILE,IEN))
Begin DoDot:3
+14 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
IF PXKNODE=""
QUIT
IF PXKNODE'=801
Begin DoDot:4
+15 IF FILE="CPT"
IF PXKNODE=1
Begin DoDot:5
+16 NEW SUBIEN,MOD
+17 SET SUBIEN=0
+18 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
IF 'SUBIEN
QUIT
Begin DoDot:6
+19 SET MOD=@VFILE@(IEN,PXKNODE,SUBIEN,0)
+20 SET @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",MOD)=""
+21 SET @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",MOD)=""
End DoDot:6
End DoDot:5
QUIT
+22 SET @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE")=$GET(@VFILE@(IEN,PXKNODE))
+23 SET @PXKROOT@(FILE,IEN,PXKNODE,"AFTER")=$GET(@VFILE@(IEN,PXKNODE))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
