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

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

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PXRRPASA ;ISL/PKR - Build and sort a list of appointments. ; 6/27/97
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**18**;Aug 12, 1996
3 ;
4SORT ;
5 N BD,BUSY,CLINIEN,DFN,DONE,ED
6 N IC,JC,FAC,FACILITY,FACNAM
7 N HLOCIEN,POV,STATUS
8 N TEMP
9 ;
10 ;Allow the task to be cleaned up upon successful completion.
11 S ZTREQ="@"
12 ;
13 I '(PXRRQUE!$D(IO("S"))) D INIT^PXRRBUSY(.BUSY)
14 ;
15 ;Build a list of hospital locations to be included in the report.
16 S TEMP=$P($G(PXRRLCSC),U,1)
17 ;
18 ;Check for selected hospital locations.
19 I TEMP="HS" D
20 . F IC=1:1:NHL D
21 .. S HLOCIEN=$P(PXRRLCHL(IC),U,2)
22 .. S FACILITY=$P(^SC(HLOCIEN,0),U,4)
23 .. I $$FACCHECK(FACILITY) D
24 ... S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,HLOCIEN)=""
25 ;
26 ;Check for selected clinics.
27 I TEMP="CS" D
28 . S IC=0
29 . F S IC=$O(^SC(IC)) Q:+IC=0 D
30 .. S DONE=0
31 .. S CLINIEN=$P(^SC(IC,0),U,7)
32 .. I +CLINIEN>0 D
33 ... F JC=1:1:NCS Q:DONE D
34 .... I CLINIEN=$P(PXRRCS(JC),U,2) D
35 ..... S FACILITY=$P(^SC(IC,0),U,4)
36 ..... I $$FACCHECK(FACILITY) S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,IC)=""
37 ..... S DONE=1
38 ;
39 ;For all hospital locations or clinic stops we have to have
40 ;all the locations in the file.
41 I (TEMP="HA")!(TEMP="CA") D
42 . S IC=0
43 . F S IC=$O(^SC(IC)) Q:+IC=0 D
44 .. S FACILITY=$P(^SC(IC,0),U,4)
45 .. I $$FACCHECK(FACILITY) D
46 ... S ^TMP(PXRRXTMP,$J,"HLOC",FACILITY,IC)=""
47 ;
48 ;Build a list of appointments for each location.
49 S FAC=""
50NFAC S FAC=$O(^TMP(PXRRXTMP,$J,"HLOC",FAC))
51 I FAC="" G APPDONE
52 ;
53 S HLOCIEN=""
54NHLOC S HLOCIEN=$O(^TMP(PXRRXTMP,$J,"HLOC",FAC,HLOCIEN))
55 I HLOCIEN="" G NFAC
56 ;
57 ;If this is an interactive session let the user know that something
58 ;is happening.
59 ;I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
60 ;
61 ;Check for a user request to stop the task.
62 I $$S^%ZTLOAD S ZTSTOP=1 D EXIT^PXRRGUT
63 ;
64 S BD=PXRRBADT-.0001
65 S ED=PXRREADT+.2359
66NDATE S BD=$O(^SC(HLOCIEN,"S",BD))
67 ;If we have passed the ending date we are done.
68 I (BD>ED)!(BD="") G NHLOC
69 ;
70 ;If this is an interactive session let the user know that something
71 ;is happening.
72 I '(PXRRQUE!$D(IO("S"))) D SPIN^PXRRBUSY("Sorting appointments",.BUSY)
73 ;
74 ;At this point we have an appointment that can be added to the list.
75 S IC=0
76 F S IC=$O(^SC(HLOCIEN,"S",BD,1,IC)) Q:+IC=0 D
77 . S DFN=$P(^SC(HLOCIEN,"S",BD,1,IC,0),U,1)
78 . S POV=$P(^DPT(DFN,"S",BD,0),U,7)
79 . S STATUS=$P(^DPT(DFN,"S",BD,0),U,2)
80 . S ^XTMP(PXRRXTMP,"APPT",FAC,HLOCIEN,DFN,BD)=STATUS_U_POV
81 ;
82 ;Get the next appointment.
83 G NDATE
84 ;
85APPDONE ;
86 I '(PXRRQUE!$D(IO("S"))) D DONE^PXRRBUSY("done")
87EXIT ;
88 K ^TMP(PXRRXTMP)
89 ;
90 ;Build the list of patient activities.
91 I PXRRQUE D
92 .;Start the report that was queued but not scheduled.
93 . N DESC,ROUTINE,TASK
94 . S DESC="Patient Activity Report - patient activities"
95 . S ROUTINE="PAT^PXRRPAPI"
96 . S ZTDTH=$$NOW^XLFDT
97 . S TASK=^XTMP(PXRRXTMP,"PATZTSK")
98 . D REQUE^PXRRQUE(DESC,ROUTINE,TASK)
99 E D PAT^PXRRPAPI
100 Q
101 ;
102 ;=======================================================================
103FACCHECK(FAC,FACILITY) ;If FAC is on the list of facilities return true.
104 N IC,FOUND
105 S FOUND=0
106 F IC=1:1:NFAC Q:FOUND D
107 . I $P(PXRRFAC(IC),U,1)=FAC D
108 .. S FOUND=1
109 Q FOUND
110 ;
Note: See TracBrowser for help on using the repository browser.