[613] | 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
|
---|