1 | SROUTL0 ;BIR/DLR,ADM - UTILITY ROUTINE ; [ 06/20/01 2:33 PM ]
|
---|
2 | ;;3.0; Surgery ;**50,100**;24 Jun 93
|
---|
3 | ;
|
---|
4 | ; Reference to ^SC( supported by DBIA #964
|
---|
5 | ;
|
---|
6 | NODATA() ;;utility to write no data
|
---|
7 | W !!
|
---|
8 | Q "No data for selected date range."
|
---|
9 | DIV(CASE) ;define the division of this case
|
---|
10 | ; CASE - File 130 ien
|
---|
11 | ; returns 0 - non-divisional match; 1 - divisonal match
|
---|
12 | N SRDIV,SROR I '$D(^SRF(CASE,0)) Q 0
|
---|
13 | I '$O(^SRO(133,1)) Q 1
|
---|
14 | I '$D(^SRF(CASE,"NON")) S SRDIV="",SROR=$P(^SRF(CASE,0),U,2) I SROR'="" S SROR=$P(^SRS(SROR,0),U) I SROR'="" S SRDIV=$P(^SC(SROR,0),U,4)
|
---|
15 | I $D(^SRF(CASE,"NON")) S SRDIV="",SROR=$P(^SRF(CASE,"NON"),U,2) I SROR'="" S SRDIV=$P(^SC(SROR,0),U,4)
|
---|
16 | I SRDIV="" S SRDIV=$P($G(^SRF(CASE,8)),U)
|
---|
17 | Q SRDIV=$G(SRSITE("DIV"))
|
---|
18 | ORDIV(OR,SRINST) ;define the division of this OR
|
---|
19 | ; OR - .01 of Operating Room in file 131.7
|
---|
20 | ; returns 0 - non-divisional match; 1 - divisonal match
|
---|
21 | N SRDIV
|
---|
22 | I '$O(^SRO(133,1)) Q 1
|
---|
23 | I SRINST="" Q 1
|
---|
24 | I SRINST["ALL" Q 1
|
---|
25 | I $G(OR)'="" S OR=$P(^SRS(OR,0),U),SRDIV=$P($G(^SC(OR,0)),U,4) I SRDIV'="" S SRDIV=$P(^(0),U,4)
|
---|
26 | Q SRDIV=SRINST
|
---|
27 | NONORDIV(CASE,NONOR) ;define nonor divisional locations (File #130,119 input transform)
|
---|
28 | ; CASE - File 130 ien
|
---|
29 | ; NONOR - File 44 ien
|
---|
30 | ; returns 0 - non-divisional match; 1 - divisonal match
|
---|
31 | N CD,IORD,RORD,SRDIV
|
---|
32 | ; CD - case date
|
---|
33 | ; SRDIV - boolean (case division MATCH)
|
---|
34 | ; IORD - Location file inactive date
|
---|
35 | ; RORD - Location file inactive date
|
---|
36 | ;
|
---|
37 | S SRDIV=1
|
---|
38 | I '$D(^SC(NONOR,0))!$G(NONOR)=""!$G(CASE)="" Q SRDIV
|
---|
39 | I '$D(^SRF(CASE,"NON")) Q 0
|
---|
40 | ;if there is no institution set for this non-or location quit
|
---|
41 | I $P(^SC(NONOR,0),U,4)="" Q 0
|
---|
42 | I $D(SRSITE("DIV")) I $P(^SC(NONOR,0),U,4)'=$G(SRSITE("DIV")) Q 0
|
---|
43 | I $D(^SC(NONOR,"I")) S CD=$P(^SRF(CASE,"NON"),U,3),IORD=$P(^SC(NONOR,"I"),U),RORD=$P(^SC(NONOR,"I"),U,2) D:IORD'=""
|
---|
44 | .I CD'<IORD,((RORD="")!(CD<RORD)) S SRDIV=0 Q
|
---|
45 | Q SRDIV
|
---|
46 | MANDIV(SRINST,CASE) ;a boolean divisional call for managerial reports
|
---|
47 | I '$D(^SRF(CASE,0)) Q 0
|
---|
48 | I '$O(^SRO(133,1)) Q 1
|
---|
49 | I SRINST["ALL" Q 1
|
---|
50 | I +SRINST'>0 Q 0
|
---|
51 | N SRDIV,SROR
|
---|
52 | I '$D(^SRF(CASE,"NON")) S SRDIV="",SROR=$P(^SRF(CASE,0),U,2) I SROR'="" S SROR=$P(^SRS(SROR,0),U) I SROR'="" S SRDIV=$P(^SC(SROR,0),U,4)
|
---|
53 | I $D(^SRF(CASE,"NON")) S SRDIV="",SROR=$P(^SRF(CASE,"NON"),U,2) I SROR'="" S SRDIV=$P(^SC(SROR,0),U,4)
|
---|
54 | I SRDIV="" S SRDIV=$P($G(^SRF(CASE,8)),U)
|
---|
55 | Q SRDIV=SRINST
|
---|
56 | INST() ;extrinsic call used by the management reports to determine division
|
---|
57 | ; Returns:
|
---|
58 | ; inst#^inst name - for one division
|
---|
59 | ; "ALL DIVISIONS" - all divisions
|
---|
60 | ; "^" - no division
|
---|
61 | N SR,SRCNT,SRINST,X S (SRCNT,X)=0 F S X=$O(^SRO(133,X)) Q:'X I '$P($G(^SRO(133,X,0)),"^",21) S SRCNT=SRCNT+1
|
---|
62 | I SRCNT=1 S SRINST=$P($$SITE^SROVAR,"^",1,2) Q SRINST
|
---|
63 | W ! K DIR,Y S DIR(0)="YO",DIR("?")="Enter 'Yes' to include all divisions, or 'No' to pick one division",DIR("A")="Do you want to print all divisions",DIR("B")="YES" D ^DIR S SRINST=$S($G(Y(0))'="":Y(0),1:"^")
|
---|
64 | I SRINST="YES" S SRINST=$P($$SITE^SROVAR,U,2)_" - ALL DIVISIONS"
|
---|
65 | I SRINST="NO" D LIST^DIC(133,"",".01","B","*","","","","","","SR") W ! D
|
---|
66 | .S X=0 F S X=$O(SR("DILIST",1,X)) Q:'X W !,X,". ",SR("DILIST",1,X)
|
---|
67 | .K DIR W ! S DIR(0)="NO^1:"_$P(SR("DILIST",0),U),DIR("A")="Select Number" D ^DIR S:+Y<1 SRINST="^" S:+Y>0 SRINST=SR("DILIST",2,+Y),DIR("?")="Enter the corresponding number of the hospital for which you want the report to run"
|
---|
68 | Q $S(SRINST["ALL DIVISIONS":SRINST,SRINST=U:SRINST,1:$P(^SRO(133,SRINST,0),U)_U_SR("DILIST",1,+Y))
|
---|
69 | SITE(CASE) ; returns pointer to file 133 indicating where case was performed
|
---|
70 | ; CASE - ien in File 130
|
---|
71 | N SRDIV,SROR S SRDIV="" I '$D(^SRF(CASE,"NON")) S SROR=$P($G(^SRF(CASE,0)),"^",2) I SROR'="" S SROR=$P(^SRS(SROR,0),"^") I SROR'="" S SRDIV=$P(^SC(SROR,0),"^",4)
|
---|
72 | I $P($G(^SRF(CASE,"NON")),"^")="Y" S SROR=$P(^SRF(CASE,"NON"),"^",2) I SROR'="" S SRDIV=$P(^SC(SROR,0),"^",4)
|
---|
73 | I SRDIV="" S SRDIV=$P($G(^SRF(CASE,8)),"^")
|
---|
74 | S:SRDIV'="" SRDIV=$O(^SRO(133,"B",SRDIV,0))
|
---|
75 | S:SRDIV="" SRDIV=$O(^SRO(133,0))
|
---|
76 | Q SRDIV
|
---|
77 | WARD(SRW,SRINST,DGPMOS) ;a boolean divisional call for active ward location
|
---|
78 | ; SRW - IEN in File 42
|
---|
79 | ; SRINST - user division
|
---|
80 | ; DGPMOS - date to check for active ward
|
---|
81 | ; returns 0 - non-divisional match; 1 - divisional match
|
---|
82 | N SRLOC,D0,X
|
---|
83 | S D0=SRW D WIN^DGPMDDCF I X=1 Q 0
|
---|
84 | I '$O(^SRO(133,1))!(SRINST="")!(SRINST["ALL") Q 1
|
---|
85 | S SRLOC=$P($G(^DIC(42,SRW,44)),"^") I SRLOC="" Q 1
|
---|
86 | S SRDIV=$P($G(^SC(SRLOC,0)),"^",4) I SRDIV="" Q 1
|
---|
87 | Q SRDIV=SRINST
|
---|
88 | HL(SRLOC,SRINST) ; define division of this hospital location
|
---|
89 | ; SRLOC - File 44 IEN
|
---|
90 | ; SRINST - user division
|
---|
91 | ; returns 0 - non-divisional match; 1 - divisional match
|
---|
92 | N SRDIV I SRINST="" Q 1
|
---|
93 | S SRDIV=0
|
---|
94 | I $G(SRLOC)'="" S SRDIV=$P($G(^SC(SRLOC,0)),"^",4) I SRDIV="" Q 1
|
---|
95 | Q SRDIV=SRINST
|
---|