source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDOQMP0.m@ 1739

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1SDOQMP0 ;ALB/SCK - Appointment Monitoring / Performance Measure Rpt. ; [07/23/96]
2 ;;5.3;SCHEDULING;**47**;AUG 13, 1993
3 ;
4 Q
5SELECT() ; Selection method for clinic selection.
6 ; Returns:
7 ; Y = S, D, or C for Stop Code, Division, or Clinic.
8 ; Y = Null for up-arrow or timeout
9 ;
10 N Y
11 S DIR(0)="SM^D:Division;S:Stop Code;C:Clinic"
12 S DIR("A")="Select clinics by: "
13 S DIR("?")="Select by either: Stop Code, Division, or Clinic"
14 S DIR("?",1)="The method by which clinics are selected for this report."
15 S DIR("B")="S"
16 D ^DIR K DIR
17 S:$D(DIRUT) Y=""
18SELQ Q $G(Y)
19 ;
20CLINIC() ; One-Many-All clinic selection
21 ; Output
22 ; CLINIC(IEN)=""
23 ;
24 W !!,"Clinic Selection"
25 S DIC="^SC(",VAUTSTR="Clinic",VAUTVB="CLINIC",VAUTNI=2,DIC("S")="I $P(^(0),U,3)[""C"""
26 D FIRST^VAUTOMA
27 I Y<0 K CLINIC
28 Q $D(CLINIC)>0
29 ;
30STOP() ; -- get stop code data
31 ; output: VAUTC := stop codes selected (VAUTC=1 for all)
32 ; return: was selection made [ 1|yes 0|no]
33 ;
34 W !!,"Stop Code Selection"
35 S DIC="^DIC(40.7,",VAUTSTR="Stop Code",VAUTVB="VAUTC",VAUTNI=2
36 D FIRST^VAUTOMA
37 I Y<0 K VAUTC
38STOPQ Q $D(VAUTC)>0
39 ;
40DIV() ; -- get division data
41 ; input: none
42 ; output: VAUTD := divs selected (VAUTD=1 for all)
43 ; return: was selection made [ 1|yes 0|no]
44 ;
45 W:$P($G(^DG(43,1,"GL")),U,2) !!,"Division Selection"
46 D ASK2^SDDIV
47 I Y<0 K VAUTD
48 Q $D(VAUTD)>0
49 ;
50STOPCDE(PMIEN) ; Get associated stop code number for clinic
51 ; Input
52 ; PMIEN - Ien of clinic in the Hospital location file
53 ;
54 ; Output
55 ; Either Stop code number, or 0 if no stop code is found
56 ;
57 N PMSC
58 S PMSC=+$P($G(^DIC(40.7,$P($G(^SC(PMIEN,0)),U,7),0)),U,2)
59 Q $S(+PMSC>0:PMSC,1:0)
60 ;
61CLNOK(PMSC) ; Checks associated stop code for clinic.
62 ; Input
63 ; PMSC - Associated stop code for current clinic
64 ;
65 ; Output
66 ; PMOK - Returns 1 if stop code is on the list
67 ; Returns 0 if it's not on the list.
68 ;
69 N PMOK,CNT,PMSTCD
70 S PMOK=0
71 F CNT=1:1 S PMSTCD=$P($T(STOPS+CNT^SDOQMPL),";;",2) Q:PMSTCD="$$END" D Q:PMOK
72 . Q:'$D(^DIC(40.7,PMSC,0))
73 . I $P($G(^DIC(40.7,PMSC,0)),U,2)=PMSTCD S PMOK=1
74 Q PMOK
75 ;
76DIVISION(PMIEN) ; Returns the name of the division the clinic as assigned to.
77 ; Input:
78 ; Ien of clinic in the Hospital location file.
79 ;
80 ; Output:
81 ; Division name in external format.
82 ;
83 N PMDIEN,PDIV
84 S PMDIV=""
85 S PMDIEN=+$P($G(^SC(PMIEN,0)),U,15)
86 G:PMDIEN'>0 DIVQ
87 S PMDIV=$P($G(^DG(40.8,PMDIEN,0)),U)
88DIVQ Q PMDIV
89 ;
90LOOPSC ; Loops through all clinics in the Hospital location file, and selects clinics that are
91 ; associated with one of the selected stop codes, adding them to the "SDAMMS" TMP global.
92 ; If VAUTC=1, then select clinics for all Stop codes.
93 ; If VAUTC=0, then select only those clinics for the Stop codes in the
94 ; VAUTC(StopCode Ien) local array.
95 ;
96 N PMSC,AMMSD0
97 S AMMSD0=0
98 ;
99 ; *** Select all
100 I VAUTC=1 D
101 . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
102 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
103 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
104 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
105 ;
106 ; *** Select only clinics with a selected associated stop code
107 I VAUTC=0&($D(VAUTC)) D
108 . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
109 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
110 .. S PMSC=$P($G(^SC(AMMSD0,0)),"^",7)
111 .. Q:'$D(VAUTC(PMSC))
112 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
113 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
114 Q
115 ;
116LOOPD ; Loops through all clinics in the Hospital location file, and select clinics that are
117 ; in one of the selected divisions, adding them to the "SDAMMS" TMP global.
118 ; If VAUTD=1, then select clinics for all Divisions.
119 ; If VAUTD=0, then select only those clinics for the Divisions in the
120 ; VAUTC(StopCode Ien) local array.
121 ;
122 N PMDIV,AMMSD0
123 ;
124 S AMMSD0=0
125 ; Select all
126 I VAUTD=1 D
127 . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
128 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
129 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
130 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
131 ;
132 I VAUTD=0&($D(VAUTD)) D
133 . F S AMMSD0=$O(^SC("AC","C",AMMSD0)) Q:'AMMSD0 D
134 .. Q:'$P($G(^SC(AMMSD0,0)),"^",7)
135 .. S PMDIV=$P($G(^SC(AMMSD0,0)),"^",15)
136 .. Q:PMDIV']""
137 .. Q:'$D(VAUTD(PMDIV))
138 .. Q:$G(^TMP("SDAMMS",$J,"Q"))=1
139 .. F X1=1:1:3 D AMMSCNT^SDOQMP1 Q:AMMSLAST=0
140 Q
141 ;
142CHKTASK() ; Checks if the expiration date has been reached. If it has, delete the option
143 ; scheduling run time field to turn off the reschedule option
144 ;
145 N OIEN,OSIEN,PMTEXT,EXPDT,SDOPT,SDWHN,SDFRQ,SDOK
146 ;
147 S SDOK=0
148 S EXPDT=$P($T(EXPIRE+1^SDOQMPL),";;",2)
149 D NOW^%DTC
150 G:$P(%,".")<EXPDT CHKQ
151 S OIEN="",OIEN=$O(^DIC(19,"B","SDOQM PM NIGHTLY JOB",OIEN))
152 Q:OIEN']""
153 S OSIEN="",OSIEN=$O(^DIC(19.2,"B",OIEN,OSIEN))
154 Q:OSIEN']""
155 ;
156 S SDWHN="@",SDFRQ="@",SDOPT="SDOQM PM NIGHTLY JOB"
157 D RESCH^XUTMOPT(SDOPT,SDWHN,"",SDFRQ,"",.SCERR)
158 ;
159 S PMTEXT(1)="The Access Performance Measure data collection job"
160 S PMTEXT(2)="has expired, and the background server has been unscheduled"
161 S PMTEXT(3)=""
162 S PMTEXT(4)="The entry in the SCHEDULING OPTION file should be removed"
163 S PMTEXT(5)="by your IRM staff"
164 S XMSUB="PM EXTRACT EXPIRATION",XMN=0
165 S XMTEXT="PMTEXT("
166 S XMDUZ=.5,XMY("G.SD PM NOTIFICATION")=""
167 D ^XMD
168 S SDOK=1
169CHKQ Q SDOK
170 ;
171LOOPS ; Use appropriate loop for building the clinic global.
172 ;
173 I $D(CLINIC) D LOOPC^SDOQMP Q
174 I $D(VAUTC) D LOOPSC Q
175 I $D(VAUTD) D LOOPD Q
176 Q
Note: See TracBrowser for help on using the repository browser.