source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCRPV1B.m@ 975

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1SCRPV1B ; bp/djb - PCMM Inconsistency Rpt - Print ; 9/13/99 3:23pm
2 ;;5.3;Scheduling;**177,231**;AUG 13, 1993
3 ;
4EN ;
5 NEW PAGE,QUIT
6 S QUIT=0
7 D HD
8 D POSITION Q:QUIT
9 D PATIENT
10 Q
11 ;
12POSITION ;Print position inconsistencies.
13 NEW NUM,POS,TM,TXT
14 ;
15 W !!,"POSITION INCONSISTENCIES"
16 W !,"------------------------",!
17 I '$D(^TMP("PCMM POSITION",$J)) W !?3,"No inconsistencies found." Q
18 I SCMODE="B" D BRIEFPOS^SCRPV1B1 Q ;Report type = Brief
19 W !?3,"INCONSISTENCY"
20 W !?6,"TEAM",?38,"POSITION",!
21 ;
22 ;Process the POSITION array
23 S NUM=0
24 F S NUM=$O(^TMP("PCMM POSITION",$J,NUM)) Q:'NUM!QUIT D ;
25 . S TXT=$T(TXT+NUM)
26 . S TXT=$P(TXT,";",4)
27 . I $Y>(IOSL-6) D PAUSE Q:QUIT
28 . W !?3,TXT
29 . S TM=""
30 . F S TM=$O(^TMP("PCMM POSITION",$J,NUM,TM)) Q:TM=""!QUIT D
31 .. S POS=""
32 .. F S POS=$O(^TMP("PCMM POSITION",$J,NUM,TM,POS)) Q:POS=""!QUIT D
33 ... I $Y>(IOSL-6) D PAUSE Q:QUIT
34 ... W !,?6,TM,?38,POS
35 Q
36 ;
37PATIENT ;Print patient inconsistencies
38 ;
39 I $Y>(IOSL-7) D PAUSE Q:QUIT
40 W !!,"PATIENT INCONSISTENCIES"
41 W !,"-----------------------",!
42 I '$D(^TMP("PCMM PATIENT",$J)) D Q
43 . W !?3,"No inconsistencies found.",!
44 I $Y>(IOSL-6) D PAUSE Q:QUIT
45 I SCMODE="B" D BRIEFPT^SCRPV1B1 Q ;Report type = Brief
46 I SCMODE="DP" D PATIENT1 Q
47 I SCMODE="DT" D PATIENT2 Q
48 Q
49 ;
50PATIENT1 ;Patient printout sorted by patient name.
51 NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
52 ;
53 W !?3,"PATIENT",?41,"SSN"
54 W !?6,"INCONSISTENCY"
55 W !?9,"TEAM",?41,"POSITION",!
56 ;
57 ;Process the PATIENT array
58 S DFNNAM=""
59 F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM=""!QUIT D ;
60 . S DFN=0
61 . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN!QUIT D ;
62 .. I $Y>(IOSL-6) D PAUSE Q:QUIT
63 .. S SSN=$P($G(^DPT(DFN,0)),U,9)
64 .. W !?3,DFNNAM,?41,SSN
65 .. S NUM=0
66 .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM!QUIT D
67 ... S VAR=0
68 ... ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
69 ... I NUM?1"8.".E S VAR=$P(NUM,".",2)
70 ... S TXT=$T(TXT+(NUM\1))
71 ... S TXT=$P(TXT,";",4)
72 ... I VAR D ;
73 .... S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
74 .... S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
75 ... I $Y>(IOSL-6) D PAUSE Q:QUIT
76 ... ;W !?6,(NUM\1),". ",TXT
77 ... W !?6,TXT
78 ... S TM=""
79 ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM=""!QUIT D
80 .... S POS=""
81 .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS=""!QUIT D
82 ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
83 ..... W !?9,TM,?41,POS
84 ..... ;
85 ..... ;Print 404.43 IEN if SCIEN is set to 1 before calling ^SCRPV1.
86 ..... I $G(SCIEN) D ;
87 ...... I $G(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) W ?72,^(POS)
88 Q
89 ;
90PATIENT2 ;Patient printout sorted by inconsistency number and then team name.
91 NEW DFN,DFNNAM,NUM,POS,SSN,TM,TXT,VAR
92 ;
93 W !,"INCONSISTENCY"
94 W !?3,"TEAM"
95 W !?6,"PATIENT",?38,"SSN",?50,"POSITION",!
96 ;
97 KILL ^TMP("PCMM PATIENT1",$J)
98 ;
99 ;Reorder PATIENT array
100 S DFNNAM=""
101 F S DFNNAM=$O(^TMP("PCMM PATIENT",$J,DFNNAM)) Q:DFNNAM="" D ;
102 . S DFN=0
103 . F S DFN=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN)) Q:'DFN D ;
104 .. S NUM=0
105 .. F S NUM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM)) Q:'NUM D ;
106 ... S TM=""
107 ... F S TM=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM)) Q:TM="" D
108 .... S POS=""
109 .... F S POS=$O(^TMP("PCMM PATIENT",$J,DFNNAM,DFN,NUM,TM,POS)) Q:POS="" D
110 ..... S ^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)=""
111 ;
112 ;Process new array
113 S NUM=0
114 F S NUM=$O(^TMP("PCMM PATIENT1",$J,NUM)) Q:'NUM!QUIT D ;
115 . S VAR=0
116 . ;If number is 8.1, 8.2 or 8.3, substitute in 3 choices below.
117 . I NUM?1"8.".E S VAR=$P(NUM,".",2)
118 . S TXT=$T(TXT+(NUM\1))
119 . S TXT=$P(TXT,";",4)
120 . I VAR D ;
121 .. S VAR=$S(VAR=1:"Team Assignment",VAR=2:"Team",1:"Position")
122 .. S TXT=$P(TXT,"[]",1)_VAR_$P(TXT,"[]",2)
123 . ;
124 . I $Y>(IOSL-6) D PAUSE Q:QUIT
125 . W !,TXT
126 . ;
127 . S TM=""
128 . F S TM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM)) Q:TM=""!QUIT D ;
129 .. I $Y>(IOSL-6) D PAUSE Q:QUIT
130 .. W !?3,TM
131 .. S DFNNAM=""
132 .. F S DFNNAM=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM)) Q:DFNNAM=""!QUIT D ;
133 ... S DFN=0
134 ... F S DFN=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN)) Q:'DFN!QUIT D
135 .... S POS=0
136 .... F S POS=$O(^TMP("PCMM PATIENT1",$J,NUM,TM,DFNNAM,DFN,POS)) Q:'POS!QUIT D ;
137 ..... S SSN=$P($G(^DPT(DFN,0)),U,9)
138 ..... I $Y>(IOSL-6) D PAUSE Q:QUIT
139 ..... W !?6,DFNNAM,?38,SSN,?50,POS
140 ;
141 KILL ^TMP("PCMM PATIENT1",$J)
142 Q
143 ;
144PAUSE ;Pause the display
145 NEW ANS,COL,PGTXT
146 S PAGE=PAGE+1
147 I $G(ION)="HFS" Q
148 S PGTXT="Page: "_PAGE
149 S COL=(IOM-$L(PGTXT)-2)
150 I $E(IOST,1,2)="P-" W @IOF,!?COL,PGTXT Q
151 W !,"<RET> to continue, ^ to quit: "
152 R ANS:DTIME S:'$T ANS="^" I ANS["^" S QUIT=1 Q
153 W @IOF,!?COL,PGTXT
154 Q
155 ;
156HD ;Heading
157 NEW HD,LINE,NOW,TM,TMN
158 ;
159 S PAGE=1
160 S HD="PCMM INCONSISTENCY REPORT"
161 ;Adjust heading if going to the P-MESSAGE device
162 I IOST["P-",IOST["MESSAGE" D Q
163 . W !?(78-$L(HD)\2),HD
164 ;
165 I $E(IOST,1,2)="P-" W !!
166 E W @IOF
167 S $P(LINE,"=",IOM)=""
168 W !?(IOM-$L(HD)\2),HD
169 S NOW=$$NOW^XLFDT()
170 I $P(NOW,".",2) S NOW=$P(NOW,".",1)_"."_$E($P(NOW,".",2),1,4)
171 S HD=$$FMTE^XLFDT(NOW)
172 W !?(IOM-$L(HD)\2),HD
173 W !,LINE
174 I SCTYPE("TM")="I" D ;
175 . W !,"See PCMM User Guide for detailed instructions."
176 E D ;
177 . W !,"Teams: "
178 . I SCTYPE("TM")="A" W "All teams"
179 . E D ;
180 .. S TM=0
181 .. F S TM=$O(SCTM(TM)) Q:'TM D ;
182 ... S TMN=$P($G(^SCTM(404.51,TM,0)),U,1)
183 ... S:TMN']"" TMN="UNKNOWN"
184 ... I ($L(TMN)+$X+2)>IOM W !?7
185 ... W TMN
186 ... I $O(SCTM(TM)) W ", "
187 W !,LINE
188 Q
189 ;
190TXT ;Inconsistencies
191 ;;1;Position has no staff assigned
192 ;;2;Patient has no PCP assigned
193 ;;3;Patient has multiple PCPs assigned
194 ;;4;AP & PCP are the same provider
195 ;;5;AP is without a Preceptor
196 ;;6;AP position is not designated for PC
197 ;;7;PCP position is not designated for PC
198 ;;8;Position assignment with inactive []
199 Q
Note: See TracBrowser for help on using the repository browser.