1 | DGYZODS ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91
|
---|
2 | ;;5.3;Registration;;Aug 13, 1993
|
---|
3 | ;
|
---|
4 | ;Determine if this patient is ODS and if software is on
|
---|
5 | ;
|
---|
6 | ;input DFN
|
---|
7 | ;output: DGODS - 1 if yes, 0 if no
|
---|
8 | ;
|
---|
9 | ;
|
---|
10 | ODS D ON I 'DGODS Q
|
---|
11 | S DGODS=0 I $D(^DPT(DFN,.32)),$D(^DIC(21,+$P(^(.32),"^",3),0)),($P(^(0),"^",3)=6) S DGODS=1
|
---|
12 | Q
|
---|
13 | ;
|
---|
14 | ON ;is the ODS software turned on?
|
---|
15 | ;
|
---|
16 | D ON^A1B2UTL S DGODS=A1B2ODS
|
---|
17 | K A1B2ODS Q
|
---|
18 | ;
|
---|
19 | ;
|
---|
20 | PT ;pass in DFN from register/admit. If it doesn't exist, create a new entry.
|
---|
21 | ;pass back DGODS=ifn of file
|
---|
22 | ;
|
---|
23 | ; INPUT DFN
|
---|
24 | ;
|
---|
25 | ; used: DGONLY - means only ods patients (do software and patient
|
---|
26 | ; checks if 1, just software checks if 0...for
|
---|
27 | ; displaced vets)
|
---|
28 | ;
|
---|
29 | N DGONLY S DGONLY=1
|
---|
30 | PT1 N DA,DIC,DIK,SSN,X,Y
|
---|
31 | I 'DFN!'$D(^DPT(DFN,0)) Q
|
---|
32 | I $D(DGONLY) D ODS I 'DGODS Q
|
---|
33 | I '$D(DGONLY) D ON I 'DGODS Q
|
---|
34 | S DGODS=$O(^A1B2(11500.1,"AD",DFN,0)) I DGODS,$D(^A1B2(11500.1,DGODS,0)) Q
|
---|
35 | S X(0)=^DPT(DFN,0),SSN=$P(X(0),"^",9) I SSN'?9N.E!($L(SSN)<9)!($L(SSN)>10) Q
|
---|
36 | ;
|
---|
37 | S X=SSN,DIC="^A1B2(11500.1,",DIC(0)="L"
|
---|
38 | K DD,DO D FILE^DICN S DGODS=+Y Q:Y'>0
|
---|
39 | F I=.32,"ODS" S X(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
|
---|
40 | D FAC^A1B2UTL
|
---|
41 | S ^A1B2(11500.1,DGODS,0)=SSN_"^"_$P(X(0),"^",1)_"^"_$P(X(0),"^",3)_"^"_$P(X(.32),"^",5)_"^"_$P(X("ODS"),"^",3)_"^"_$P(X("ODS"),"^",2)_"^"_$S($D(^DPT(DFN,"DAC")):$P(^("DAC"),"^",1),1:"")_"^"_$S($D(DGONLY):1,1:0)_"^^^^"_DFN_"^"_A1B2FN
|
---|
42 | S ^A1B2(11500.1,DGODS,.11)=$S($D(^DPT(DFN,.11)):^(.11),1:"") S X=^(.11),$P(^A1B2(11500.1,DGODS,.11),"^",7)=$S($D(^DIC(5,+$P(X,"^",5),1,+$P(X,"^",7),0)):$P(^(0),"^",1),1:"")
|
---|
43 | S ^A1B2(11500.1,DGODS,1)=2
|
---|
44 | S DA=DGODS,DIK=DIC D IX1^DIK
|
---|
45 | Q
|
---|
46 | ;
|
---|
47 | ;
|
---|
48 | DFN ;Called from admit templates to N DFN
|
---|
49 | N DFN S DFN=$P(^DGPM(DA,0),"^",3)
|
---|
50 | D ODS
|
---|
51 | Q
|
---|