source: WorldVistAEHR/trunk/r/PHARMACY_DATA_MANAGEMENT-PSS/PSSSCHED.m@ 1259

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1PSSSCHED ;BIR/JMC-BUILD SCHEDULE LIST FOR CPRS GUI SELECTION;02/27/08
2 ;;1.0;PHARMACY DATA MANAGEMENT;**94**;9/30/97;Build 26
3 ;
4 ;
5 Q ;Cannot be called directly. Must use API
6 ;
7SCHED(PSSWIEN,PSSARRY) ;Receive ward IEN from CPRS and return list of schedules.
8 ;
9 ;PSSWIEN = Ward IEN
10 ;PSSARRY = array passed by reference from CPRS
11 ;
12 ;If there is a duplicate schedule, and if one of them contains
13 ;ward-specific admin times for the ward location of the patient,
14 ;the schedule returned for inclusion in the list of selectable
15 ;schedules to CPRS will be the one with the ward-specific admin
16 ;times. If neither duplicate has ward-specific admin times,
17 ;then the current functionality of the schedule with the lowest
18 ;IEN number will remain in place. If both (or more than one)
19 ;duplicate schedules have ward-specific admin times for the ward
20 ;location of the patient, then the one with the lowest IEN number
21 ;will be the schedule returned to CPRS.
22 ;
23 ;Example: Patient's ward location is ICU
24 ;^PS(51.1,"APPSJ","BID",1)=""
25 ;^PS(51.1,"APPSJ","BID",2)=""
26 ;
27 ;If ^PS(51.1,1 does not have ward-specific admin times for
28 ;the ICU, but ^PS(51.1,2 does, ^PS(51.1,2 will be in the list
29 ;of schedules returned to CPRS.
30 ;
31 ;If neither schedule has ward-specific admin times for the ICU
32 ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
33 ;
34 ;If both schedules have ward-specific admin times for the ICU
35 ;then ^PS(51.1,1 will be in the list of schedules returned to CPRS.
36 ;
37 ;The returned array to CPRS will be in the format:
38 ;PSSARRY(n)=IEN^NAME^OUTPATIENT EXPANSION^SCHEDULE TYPE^ADMIN TIME
39 ;
40 N PSSSKED,PSSSKED1,PSSSK
41 K ^TMP("PSSADMIN"),^TMP("PSSDUP")
42 I $G(PSSWIEN)="" S PSSWIEN=0
43 S PSSSKED=""
44 F S PSSSKED=$O(^PS(51.1,"APPSJ",PSSSKED)) Q:PSSSKED="" D
45 . S PSSSKED1="",PSSSK=1
46 . F S PSSSKED1=$O(^PS(51.1,"APPSJ",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
47 . . Q:$P($G(^PS(51.1,PSSSKED1,0)),"^",5)=""
48 . . S ^TMP("PSSDUP",$J,PSSSKED,PSSSK)=PSSSKED1 ;Identify duplicate schedules to work with.
49 . . S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$S($P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)'="":$P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2),1:$P($G(^PS(51.1,PSSSKED1,0)),"^",2))
50 . . S PSSSK=PSSSK+1
51 . I '$D(^TMP("PSSDUP",$J,PSSSKED,2)) K ^TMP("PSSDUP",$J,PSSSKED)
52 I $D(^TMP("PSSDUP")) D DUP,FORMAT,KILL Q ;Duplicate schedules - determine if any have ward-specific admin times
53 I '$D(^TMP("PSSDUP")) D FORMAT,KILL Q ;No duplicates in the schedule file - format for proper return to CPRS
54 Q
55KILL ;
56 K ^TMP("PSSADMIN"),PSSSKED,PSSSKED1,PSSSK,PSSWIEN
57 Q
58DUP ;Compare duplicates to see if any have ward-specific admin times.
59 S PSSSKED="",PSSSKED1=""
60 F S PSSSKED=$O(^TMP("PSSDUP",$J,PSSSKED)) Q:PSSSKED="" D
61 . S PSSSK=""
62 . F S PSSSK=$O(^TMP("PSSDUP",$J,PSSSKED,PSSSK)) Q:PSSSK="" D
63 . . S PSSSKED1=$G(^TMP("PSSDUP",$J,PSSSKED,PSSSK))
64 . . I '$D(^TMP("PSSADMIN",$J,"STD",PSSSKED)) S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$P($G(^PS(51.1,PSSSKED1,0)),"^",2)
65 . . I '$D(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),PSSSK>1 K ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1) Q
66 . . I $D(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),'$D(^TMP("PSSADMIN",$J,"WARD",PSSSKED)) S ^TMP("PSSADMIN",$J,"WARD",PSSSKED,PSSSKED1)=$P($G(^PS(51.1,PSSSKED1,1,PSSWIEN,0)),"^",2)
67 . . I $D(^TMP("PSSADMIN",$J,"WARD",PSSSKED)) D Q
68 . . . K ^TMP("PSSADMIN",$J,"STD",PSSSKED)
69 . . . S ^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)=$G(^TMP("PSSADMIN",$J,"WARD",PSSSKED,PSSSKED1))
70 . . . K ^TMP("PSSADMIN",$J,"WARD",PSSSKED)
71 K ^TMP("PSSDUP")
72 Q
73FORMAT ;Format array for proper return to CPRS
74 N PSSCNTR,PSSTMP
75 S PSSSKED="",PSSSKED1="",PSSCNTR=1
76 F S PSSSKED=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED)) Q:PSSSKED="" D
77 . F S PSSSKED1=$O(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1)) Q:PSSSKED1="" D
78 . . S PSSTMP=$G(^PS(51.1,PSSSKED1,0))
79 . . S PSSARRY(PSSCNTR)=PSSSKED1_"^"_PSSSKED_"^"_$P(PSSTMP,"^",8)_"^"_$P(PSSTMP,"^",5)_"^"_$G(^TMP("PSSADMIN",$J,"STD",PSSSKED,PSSSKED1))
80 . . S PSSCNTR=PSSCNTR+1
81 K PSSCNTR,PSSTMP
82 Q
Note: See TracBrowser for help on using the repository browser.