source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYZODS.m@ 1042

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

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1DGYZODS ;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 ;
10ODS 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 ;
14ON ;is the ODS software turned on?
15 ;
16 D ON^A1B2UTL S DGODS=A1B2ODS
17 K A1B2ODS Q
18 ;
19 ;
20PT ;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
30PT1 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 ;
48DFN ;Called from admit templates to N DFN
49 N DFN S DFN=$P(^DGPM(DA,0),"^",3)
50 D ODS
51 Q
Note: See TracBrowser for help on using the repository browser.