source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMLOCL.m@ 1261

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

revised back to 6/30/08 version

File size: 4.8 KB
Line 
1PXRMLOCL ; SLC/PKR - Handle location findings. ;07/17/2006
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;This routine is for location list patient lists.
4 ;=============================================
5ALLLOCS(SUB) ;Build a list of all hospital locations associated
6 ;with Visit file entries.
7 N HLOC
8 K ^TMP($J,SUB)
9 S HLOC=""
10 ;DBIA #2028
11 F S HLOC=$O(^AUPNVSIT("AHL",HLOC)) Q:HLOC="" S ^TMP($J,SUB,HLOC)=""
12 Q
13 ;
14 ;=============================================
15EVALPL(FINDPA,ENODE,TERMARR,PLIST) ;Evaluate location term findings
16 ;for patient lists. Return the list in ^TMP($J,PLIST)
17 N BDT,EDT,ITEM,FILENUM,PFINDPA
18 N STATUSA,TEMP,TFINDING,TFINDPA
19 S FILENUM=$$GETFNUM^PXRMDATA(ENODE)
20 S ITEM=""
21 F S ITEM=$O(TERMARR("E",ENODE,ITEM)) Q:+ITEM=0 D
22 . S TFINDING=""
23 . F S TFINDING=$O(TERMARR("E",ENODE,ITEM,TFINDING)) Q:+TFINDING=0 D
24 .. K PFINDPA,TFINDPA
25 .. M TFINDPA=TERMARR(20,TFINDING)
26 ..;Set the finding parameters.
27 .. D SPFINDPA^PXRMTERM(.FINDPA,.TFINDPA,.PFINDPA)
28 .. D GPLIST(FILENUM,"IP",ITEM,.PFINDPA,PLIST)
29 Q
30 ;
31 ;=============================================
32FPLIST(FILENUM,HLOCL,NOCC,BDT,EDT,PLIST) ;Find patient list data for
33 ;a visit to a hospital location. Return the list in ^TMP($J,PLIST).
34 N BTIME,DAS,DATE,DEND,DFN,DONE,DS,ETIME,HLOC,INVBD,INVDATE,INVDT,INVED
35 N NFOUND,TEMP,TGLIST,TIME
36 S TGLIST="FPLIST_PXRMLOCL"
37 K ^TMP($J,TGLIST)
38 S DEND=$S(EDT[".":EDT,1:EDT+.240001)
39 ;"AHL" in Visit file is inverse date_.time instead of a full inverse
40 ;date and time. For example if the date/time is 3030704.104449 then
41 ;"AHL" has 6969295.104449 instead of 6969295.89555
42 S INVBD=9999999-$P(BDT,".",1),BTIME=+("."_$P(BDT,".",2))
43 S INVED=9999999-$P(DEND,".",1),ETIME=+("."_$P(DEND,".",2))
44 S DS=INVED-1
45 S HLOC=""
46 F S HLOC=$O(^TMP($J,HLOCL,HLOC)) Q:HLOC="" D
47 . S INVDT=DS,DONE=0
48 .;DBIA #2028
49 . F S INVDT=$O(^AUPNVSIT("AHL",HLOC,INVDT)) Q:(DONE)!(INVDT="") D
50 .. S INVDATE=$P(INVDT,".",1)
51 .. I INVDATE>INVBD S DONE=1 Q
52 .. S TIME=+("."_$P(INVDT,".",2))
53 .. I INVDATE=INVED,TIME>ETIME Q
54 .. I INVDATE=INVBD,BTIME>TIME S DONE=1 Q
55 .. S DAS=0
56 .. F S DAS=$O(^AUPNVSIT("AHL",HLOC,INVDT,DAS)) Q:DAS="" D
57 ...;Check the associated appointment for a valid status.
58 ... I '$$VAPSTAT^PXRMVSIT(DAS) Q
59 ... S TEMP=^AUPNVSIT(DAS,0)
60 ... S DFN=$P(TEMP,U,5)
61 ... S DATE=$P(TEMP,U,1)
62 ... S ^TMP($J,TGLIST,DFN,INVDT,DAS)=DATE_U_HLOC
63 ;Return the NOCC most recent for each patient.
64 S DFN=0
65 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
66 . S (INVDT,NFOUND)=0
67 . F S INVDT=$O(^TMP($J,TGLIST,DFN,INVDT)) Q:(NFOUND=NOCC)!(INVDT="") D
68 .. S DAS=""
69 .. F S DAS=$O(^TMP($J,TGLIST,DFN,INVDT,DAS)) Q:(NFOUND=NOCC)!(DAS="") D
70 ... S NFOUND=NFOUND+1
71 ... S ^TMP($J,PLIST,DFN,NFOUND)=DAS_U_^TMP($J,TGLIST,DFN,INVDT,DAS)
72 K ^TMP($J,TGLIST)
73 Q
74 ;
75 ;=============================================
76GPLIST(FILENUM,SNODE,ITEM,PFINDPA,PLIST) ;Add to the patient list.
77 ; Return the list in ^TMP($J,PLIST).
78 ;^TMP($J,PLIST,T/F,DFN,IND,FILENUM)=DAS^DATE^HLOC^VALUE
79 N BDT,CASESEN,COND,CONVAL,DAS,DATE,EDT,DFN,FIEVD,FLIST
80 N ICOND,IEN,IND,IPLIST,LNAME,NOCC,NFOUND,NGET,NP,SAVE,STATUSA
81 N TEMP,TGLIST,TPLIST,UCIFS,VALUE,VSLIST
82 S TGLIST="GPLIST_PXRMLOCL"
83 ;Set the finding search parameters.
84 D SSPAR^PXRMUTIL(PFINDPA(0),.NOCC,.BDT,.EDT)
85 S NOCC=$S(NOCC<0:-NOCC,1:NOCC)
86 D SCPAR^PXRMCOND(.PFINDPA,.CASESEN,.COND,.UCIFS,.ICOND,.VSLIST)
87 S NGET=$S(UCIFS:"*",$D(STATUSA):"*",1:NOCC)
88 ;Get a list of unique locations.
89 S LNAME=$P(^PXRMD(810.9,ITEM,0),U,1)
90 I LNAME="VA-ALL LOCATIONS" D ALLLOCS("HLOCL")
91 I LNAME'="VA-ALL LOCATIONS" D LOCLIST^PXRMLOCF(ITEM,"HLOCL")
92 D FPLIST(FILENUM,"HLOCL",NGET,BDT,EDT,TGLIST)
93 S DFN=""
94 F S DFN=$O(^TMP($J,TGLIST,DFN)) Q:DFN="" D
95 . K TPLIST
96 . M TPLIST=^TMP($J,TGLIST,DFN)
97 . S (IND,NFOUND)=0
98 . K IPLIST
99 . F S IND=$O(TPLIST(IND)) Q:(IND="")!(NFOUND=NOCC) D
100 .. S TEMP=TPLIST(IND)
101 .. S DAS=$P(TEMP,U,1)
102 .. D GETDATA^PXRMDATA(FILENUM,DAS,.FIEVD)
103 .. S VALUE=$G(FIEVD("VALUE"))
104 .. S CONVAL=$S(COND'="":$$COND^PXRMCOND(CASESEN,ICOND,VSLIST,.FIEVD),1:1)
105 .. S SAVE=$S('UCIFS:1,(UCIFS&CONVAL):1,1:0)
106 .. I SAVE D
107 ... S NFOUND=NFOUND+1
108 ... S IPLIST(CONVAL,DFN,NFOUND,FILENUM)=TEMP_U_VALUE
109 . M ^TMP($J,PLIST)=IPLIST
110 K ^TMP($J,"HLOCL"),^TMP($J,TGLIST)
111 Q
112 ;
113 ;=============================================
114PCSTOPL ;Print the Clinic Stop list. Called by the print template PXRM
115 ;LOCATION LIST INQUIRY.
116 N AMIS,CSTOP,IND,JND,SKIP,TEMP
117 S (IND,SKIP)=0
118 F S IND=+$O(^PXRMD(810.9,D0,40.7,IND)) Q:IND=0 D
119 . S TEMP=^PXRMD(810.9,D0,40.7,IND,0)
120 . S CSTOP=$P(TEMP,U,1)
121 .; DBIA #557
122 . S CSTOP=$P(^DIC(40.7,CSTOP,0),U,1)
123 . S AMIS=$P(TEMP,U,2)
124 . I SKIP W ! S SKIP=0
125 . W !,?2,CSTOP,?34,AMIS
126 . I '$D(^PXRMD(810.9,D0,40.7,IND,1)) Q
127 . S SKIP=1
128 . W !,?4,"Credit Stops to Exclude:"
129 . S JND=0
130 . F S JND=+$O(^PXRMD(810.9,D0,40.7,IND,1,JND)) Q:JND=0 D
131 .. S TEMP=^PXRMD(810.9,D0,40.7,IND,1,JND,0)
132 .. S TEMP=$P(^DIC(40.7,TEMP,0),U,1,2)
133 .. S CSTOP=$P(TEMP,U,1)
134 .. S AMIS=$P(TEMP,U,2)
135 .. W !,?6,CSTOP,?38,AMIS
136 Q
137 ;
Note: See TracBrowser for help on using the repository browser.