source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXKENC.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1PXKENC ;ISL/dee,ESW - Builds the array of all encounter data for the event point ; 12/5/02 11:53am ; 1/5/07 4:54pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**15,22,73,108,143,183**;Aug 12, 1996;Build 3
3 Q
4 ;
5GETENC(DFN,ENCDT,HLOC) ;Get all of the encounter data
6 ;Parameters:
7 ; DFN Pointer to the patient (#9000001)
8 ; ENCDT Date/Time of the encounter in Fileman format
9 ; HLOC Pointer to Hospital Location (#44)
10 ;
11 ;Returns:
12 ; -2 if called incorrectly
13 ; -1 if could not find encounter
14 ; >0 Visit ien(s) separated by ^
15 ;
16 ; The encounter is returned in the array
17 ; ^TMP("PXKENC",$J,pointer to visit)
18 ; may contain more than one visit
19 ;
20 N VISITIEN,REVDT,RETURN
21 K ^TMP("PXKENC",$J)
22 S RETURN=-1
23 Q:DFN'>0!(ENCDT<1800000)!(HLOC'>0) -2
24 S REVDT=(9999999-$P(+ENCDT,".",1))_$S($P(+ENCDT,".",2)'="":"."_$P(+ENCDT,".",2),1:"")
25 S VISITIEN=0
26 F S VISITIEN=$O(^AUPNVSIT("AA",+DFN,REVDT,VISITIEN)) Q:'VISITIEN D
27 . I $P($G(^AUPNVSIT(VISITIEN,0)),"^",22)=HLOC,"C~S"'[$P($G(^AUPNVSIT(VISITIEN,150)),"^",3) D
28 .. D ENCEVENT(VISITIEN,1)
29 .. I RETURN<1 S RETURN=VISITIEN
30 .. E S RETURN=RETURN_"^"_VISITIEN
31 Q RETURN
32 ;
33ENCEVENT(VISITIEN,DONTKILL) ;Create the ^TMP("PXKENC",$J, array of all the
34 ; information about one encounter.
35 ;Parameters:
36 ; VISITIEN Pointer to the Visit (#9000010)
37 ; DONOTKILL is 1 if the output array is not to be killed before used
38 ; and 0 or null if the array is to be killed (cleaned out)
39 ;
40 ; The encounter is returned in the array
41 ; ^TMP("PXKENC",$J,pointer to visit)
42 ;
43 I $G(VISITIEN)'>0 Q ;PX/183
44 I '$D(^AUPNVSIT(VISITIEN)) Q
45 K:'$G(DONTKILL) ^TMP("PXKENC",$J)
46 N PXKCNT,PXKROOT
47 S PXKROOT=$NA(@("^TMP(""PXKENC"",$J,"_VISITIEN_")"))
48 ;
49 N IEN,FILE,VFILE,FILESTR,PXKNODE
50 F FILE="SIT","CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
51 . S FILESTR=$S(FILE="SIT":"VST",1:FILE)
52 . S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="SIT":"VST",FILE="CSTP":"VST",1:FILE))),";;",2)
53 . I FILE="SIT" D
54 .. S IEN=VISITIEN
55 .. S PXKNODE=""
56 .. F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D
57 ... S @PXKROOT@(FILESTR,IEN,PXKNODE)=@VFILE@(IEN,PXKNODE)
58 . E D
59 .. I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILESTR)
60 .. I FILE'="PRV" S IEN="" F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
61 ... I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
62 ... S PXKNODE=""
63 ... F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
64 .... ;for cpt modifiers
65 .... I FILE="CPT",PXKNODE=1 D Q
66 ..... S @PXKROOT@(FILESTR,IEN,PXKNODE,0)=$G(@VFILE@(IEN,PXKNODE,0))
67 ..... N SUBIEN
68 ..... S SUBIEN=0
69 ..... F S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:SUBIEN="" D
70 ...... S @PXKROOT@(FILESTR,IEN,PXKNODE,SUBIEN,0)=$G(@VFILE@(IEN,PXKNODE,SUBIEN,0))
71 .... ;
72 .... S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
73 Q
74EVALD(VISITIEN,PXKROOT,VFILE,FILESTR) ;evaluation for duplicate providers
75 N CNT,PR,PRS,PS,PP,PRV,STR
76 S IEN="",CNT=0
77 F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
78 .S STR=@VFILE@(IEN,0),PR=+STR,PS=$P(STR,U,4)
79 .I PS="P",'CNT S PRV=PR,CNT=1 D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
80 .I PS="S" S PRS(PR,IEN)="" D PXKNODE(VFILE,FILESTR,IEN,PXKROOT)
81 .Q
82 S PR="" F S PR=$O(PRS(PR)) Q:PR="" S IEN="" D
83 .F PP=1:1 S IEN=$O(PRS(PR,IEN)) Q:IEN="" D
84 ..I PR=$G(PRV) K @PXKROOT@(FILESTR,IEN) Q
85 ..I PP>1 K @PXKROOT@(FILESTR,IEN)
86 Q
87PXKNODE(VFILE,FILESTR,IEN,PXKROOT) ;
88 N STRR S PXKNODE=""
89 F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
90 . I $E($P($P(PXKROOT,","),"(",2),2,7)="PXKENC" D
91 ..; ENCEVENT called
92 .. S @PXKROOT@(FILESTR,IEN,PXKNODE)=$G(@VFILE@(IEN,PXKNODE))
93 . I $P(PXKROOT,"""",2)="PXKCO",'$D(@PXKROOT@(FILESTR,IEN)) D
94 ..; COEVENT called
95 .. F STRR="BEFORE","AFTER" D
96 ... S @PXKROOT@(FILESTR,IEN,PXKNODE,STRR)=$G(@VFILE@(IEN,PXKNODE))
97 Q
98 ;
99COEVENT(VISITIEN) ;Add to the ^TMP("PXKCO",$J, array all of the
100 ; information that is not already there.
101 I '$D(^AUPNVSIT(VISITIEN)) Q
102 N PXKCNT,PXKROOT
103 S PXKROOT=$NA(@("^TMP(""PXKCO"",$J,"_VISITIEN_")"))
104 ;
105 N IEN,FILE,VFILE,PXKNODE
106 F FILE="CSTP","PRV","POV","CPT","TRT","IMM","PED","SK","HF","XAM" D
107 . S VFILE=$P($T(GLOBAL^@("PXKF"_$S(FILE="CSTP":"VST",1:FILE))),";;",2)
108 . I FILE="PRV" D EVALD(VISITIEN,PXKROOT,VFILE,FILE)
109 . I FILE'="PRV" S IEN="" F S IEN=$O(@VFILE@("AD",VISITIEN,IEN)) Q:'IEN D
110 .. I FILE="CSTP","SC"'[$P($G(@VFILE@(IEN,150)),"^",3) Q
111 .. S PXKNODE=""
112 .. I '$D(@PXKROOT@(FILE,IEN)) D
113 ... F S PXKNODE=$O(@VFILE@(IEN,PXKNODE)) Q:PXKNODE="" D:PXKNODE'=801
114 .... I FILE="CPT",PXKNODE=1 D Q
115 ..... N SUBIEN,MOD
116 ..... S SUBIEN=0
117 ..... F S SUBIEN=$O(@VFILE@(IEN,PXKNODE,SUBIEN)) Q:'SUBIEN D
118 ...... S MOD=@VFILE@(IEN,PXKNODE,SUBIEN,0)
119 ...... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE",MOD)=""
120 ...... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER",MOD)=""
121 .... S @PXKROOT@(FILE,IEN,PXKNODE,"BEFORE")=$G(@VFILE@(IEN,PXKNODE))
122 .... S @PXKROOT@(FILE,IEN,PXKNODE,"AFTER")=$G(@VFILE@(IEN,PXKNODE))
123 Q
124 ;
Note: See TracBrowser for help on using the repository browser.