PXKENC ;ISL/dee,ESW - Builds the array of all encounter data for the event point ;07/13/2021
;;1.0;PCE PATIENT CARE ENCOUNTER;**15,22,73,108,143,183,210,215,211,217**;Aug 12, 1996;Build 134
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^PXKENCOUNTER(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 $G(VISITIEN)'>0 Q ;PX/183
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,TEMP
F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM","ICR","SC" 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))
.... ;for immunizatin multiples
.... I FILE="IMM",PXKNODE?1(1"2",1"3",1"11") D Q
..... 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 TEMP=$G(@VFILE@(IEN,PXKNODE))
....;Check for a bad pointer in ^AUPNVPOV(IEN,802).
.... I (FILE="POV"),(PXKNODE=802),(+TEMP'>0) S TEMP=""
.... S @PXKROOT@(FILESTR,IEN,PXKNODE)=TEMP
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))
. I $P(PXKROOT,"""",2)="PXKCO",'$D(@PXKROOT@(FILESTR,IEN)) 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","ICR","SC" 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="IMM",PXKNODE?1(1"2",1"3",1"11") D Q
..... N SUBIEN,VAL
..... S SUBIEN=0
..... F S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:'SUBIEN D
...... S VAL=$G(@VFILE@(IEN,PXKNODE,SUBIEN,0))
...... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",SUBIEN)=VAL
...... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",SUBIEN)=VAL
.... ;
.... 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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXKENC 5785 printed Dec 13, 2024@02:29:09 Page 2
PXKENC ;ISL/dee,ESW - Builds the array of all encounter data for the event point ;07/13/2021
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,22,73,108,143,183,210,215,211,217**;Aug 12, 1996;Build 134
+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^PXKENCOUNTER(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 ;PX/183
IF $GET(VISITIEN)'>0
QUIT
+11 IF '$DATA(^AUPNVSIT(VISITIEN))
QUIT
+12 if '$GET(DONTKILL)
KILL ^TMP("PXKENC",$JOB)
+13 NEW PXKCNT,PXKROOT
+14 SET PXKROOT=$NAME(@("^TMP(""PXKENC"",$J,"_VISITIEN_")"))
+15 ;
+16 NEW IEN,FILE,VFILE,FILESTR,PXKNODE,TEMP
+17 FOR FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM","ICR","SC"
Begin DoDot:1
+18 SET FILESTR=$SELECT(FILE="SIT":"VST",1:FILE)
+19 SET VFILE=$PIECE($TEXT(GLOBAL^@("PXKF"_$SELECT(FILE="SIT":"VST",FILE="CSTP":"VST",1:FILE))),";;",2)
+20 IF FILE="SIT"
Begin DoDot:2
+21 SET IEN=VISITIEN
+22 SET PXKNODE=""
+23 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
if PXKNODE=""
QUIT
Begin DoDot:3
+24 SET @PXKROOT@(FILESTR,IEN,PXKNODE)=@VFILE@(IEN,PXKNODE)
End DoDot:3
End DoDot:2
+25 IF '$TEST
Begin DoDot:2
+26 IF FILE="PRV"
DO EVALD(VISITIEN,PXKROOT,VFILE,FILESTR)
+27 IF FILE'="PRV"
SET IEN=""
FOR
SET IEN=$ORDER(@VFILE@("AD",VISITIEN,IEN))
if 'IEN
QUIT
Begin DoDot:3
+28 IF FILE="CSTP"
IF "SC"'[$PIECE($GET(@VFILE@(IEN,150)),"^",3)
QUIT
+29 SET PXKNODE=""
+30 FOR
SET PXKNODE=$ORDER(@VFILE@(IEN,PXKNODE))
if PXKNODE=""
QUIT
if PXKNODE'=801
Begin DoDot:4
+31 ;for CPT modifiers
+32 IF FILE="CPT"
IF PXKNODE=1
Begin DoDot:5
+33 SET @PXKROOT@(FILESTR,IEN,PXKNODE,0)=$GET(@VFILE@(IEN,PXKNODE,0))
+34 NEW SUBIEN
+35 SET SUBIEN=0
+36 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
if SUBIEN=""
QUIT
Begin DoDot:6
+37 SET @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$GET(@VFILE@(IEN,PXKNODE,SUBIEN,0))
End DoDot:6
End DoDot:5
QUIT
+38 ;for immunizatin multiples
+39 IF FILE="IMM"
IF PXKNODE?1(1"2",1"3",1"11")
Begin DoDot:5
+40 NEW SUBIEN
+41 SET SUBIEN=0
+42 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:6
+43 SET @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$GET(@VFILE@(IEN,PXKNODE,SUBIEN,0))
End DoDot:6
End DoDot:5
QUIT
+44 SET TEMP=$GET(@VFILE@(IEN,PXKNODE))
+45 ;Check for a bad pointer in ^AUPNVPOV(IEN,802).
+46 IF (FILE="POV")
IF (PXKNODE=802)
IF (+TEMP'>0)
SET TEMP=""
+47 SET @PXKROOT@(FILESTR,IEN,PXKNODE)=TEMP
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+48 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 $PIECE(PXKROOT,"""",2)="PXKCO"
IF '$DATA(@PXKROOT@(FILESTR,IEN))
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","ICR","SC"
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 ;
+16 IF FILE="IMM"
IF PXKNODE?1(1"2",1"3",1"11")
Begin DoDot:5
+17 NEW SUBIEN,VAL
+18 SET SUBIEN=0
+19 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:6
+20 SET VAL=$GET(@VFILE@(IEN,PXKNODE,SUBIEN,0))
+21 SET @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",SUBIEN)=VAL
+22 SET @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",SUBIEN)=VAL
End DoDot:6
End DoDot:5
QUIT
+23 ;
+24 IF FILE="CPT"
IF PXKNODE=1
Begin DoDot:5
+25 NEW SUBIEN,MOD
+26 SET SUBIEN=0
+27 FOR
SET SUBIEN=$ORDER(@VFILE@(IEN,PXKNODE,SUBIEN))
if 'SUBIEN
QUIT
Begin DoDot:6
+28 SET MOD=@VFILE@(IEN,PXKNODE,SUBIEN,0)
+29 SET @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",MOD)=""
+30 SET @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",MOD)=""
End DoDot:6
End DoDot:5
QUIT
+31 ;
+32 SET @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE")=$GET(@VFILE@(IEN,PXKNODE))
+33 SET @PXKROOT@(FILE,IEN,PXKNODE,"AFTER")=$GET(@VFILE@(IEN,PXKNODE))
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
+35 ;
