source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDPMUT2.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.7 KB
Line 
1SDPMUT2 ;BPFO/JRC - Performance Monitors Utilities ; 11/3/03 3:24pm
2 ;;5.3;SCHEDULING;**292,322,474**;AUGUST 13, 1993;Build 4
3 ;
4SCREEN(PTRENC,SCRNARR) ;Screen Outpatient Encounter
5 ;Input : PTRENC - Outpatient Encounter IEN
6 ; SCRNARR - Screening array full global reference
7 ;Output : 1 = Screen encounter out
8 ; 0 = Keep encounter and process
9 ;
10 ;Declare variables
11 N PCODE,SCODE,CLINIC,NODE,Y,I,CHLD,PROV,TYPE
12 S NODE=$G(^SCE(PTRENC,0))
13 ;Can not be test patient
14 I $$TESTPAT^VADPT($P(NODE,U,2)) Q 1
15 ;Encounter must be checked out
16 I '$P(NODE,U,7) Q 1
17 ;Can't be child encounter
18 I +$P(NODE,U,6) Q 1
19 ;Screen out non-count clinics
20 S CLINIC=$P($G(NODE),U,4)
21 I 'CLINIC Q 1
22 I $P($G(^SC(CLINIC,0)),U,17)="Y" Q 1
23 ;Appointment type must be regular or service connected
24 ;service connected added - SD*5.3*474
25 I $P($G(NODE),U,10) S TYPE=$P($G(^SD(409.1,$P($G(NODE),U,10),0)),U,1)
26 I '$D(TYPE) Q 1
27 I TYPE'["REGULAR" I TYPE'["SERVICE CONNECTED" Q 1
28 ;Get primary & secondary stop codes
29 S PCODE=+$P(NODE,U,3)
30 S CHLD=+$O(^SCE("APAR",PTRENC,0))
31 S SCODE=0
32 I CHLD D
33 .S SCODE=+$P($G(^SCE(CHLD,0)),U,3)
34 ;Check stop codes (in inclusion list and/or not in exclusion list)
35 S Y=$S($O(@SCRNARR@("DSS",0)):1,$O(@SCRNARR@("DSS-PAIR",0)):1,1:0)
36 I 'PCODE Q 1
37 I @SCRNARR@("DSS")=1 S Y=0
38 I $D(@SCRNARR@("DSS",PCODE)) S Y=0
39 I $D(@SCRNARR@("DSS-EXCLUDE",PCODE))!$D(@SCRNARR@("DSS-EXCLUDE",SCODE)) S Y=1
40 I Y Q 1
41 ;Check division (must be in list)
42 S Y=1
43 S DIV=$P(NODE,U,11)
44 I 'DIV Q 1
45 I @SCRNARR@("DIVISION")=1 S Y=0
46 I $D(@SCRNARR@("DIVISION",DIV)) S Y=0
47 I Y Q 1
48 ;Get primary encounter provider
49 S Y=1
50 S PROV=$$ENCPROV(PTRENC)
51 ;Check primary encounter provider (must be in list)
52 I 'PROV Q 1
53 I @SCRNARR@("PROVIDERS")=1 S Y=0
54 I $D(@SCRNARR@("PROVIDERS",PROV)) S Y=0
55 I Y Q 1
56 ;Passed all screens
57 Q 0
58 ;
59NOTEINF(PTRENC) ;Returns performance monitor information for a given encounter
60 ;Input : PTRENC - Outpatient Encounter IEN
61 ;Output: Results of calling $$PM^TIUPXPM
62 ; String with 6 fields ('^' delimiter)
63 ; 1 VIEN
64 ; 2 Note Category (A-E)
65 ; 3 Signed By (pointer to File #200)
66 ; 4 Signed Date.Time (FM format)
67 ; 5 Co-signed By (pointer to File #200) - defined only if necessary
68 ; 6 Co-signed Date.Time - defined only if necessary
69 ;
70 N VIEN
71 S VIEN=$P(^SCE(PTRENC,0),U,5)
72 Q $$PM^TIUPXPM(VIEN)
73 ;
74ENCPROV(PTRENC) ;Return primary encounter provider
75 ;Input : ENCPTR - Pointer to Outpatient Encounter
76 ;Output : Pointer to New Person File
77 ;Note : 0 returned if primary encounter provider not found
78 N NODE,PROV,X
79 D GETPRV^SDOE(PTRENC,"NODE")
80 S PROV=0
81 S X=0 F S X=+$O(NODE(X)) Q:'X D Q:PROV
82 .I $P(NODE(X),"^",4)="P" S PROV=+NODE(X)
83 Q PROV
Note: See TracBrowser for help on using the repository browser.