Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGYZODS

DGYZODS.m

Go to the documentation of this file.
  1. DGYZODS ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91
  1. ;;5.3;Registration;;Aug 13, 1993
  1. ;
  1. ;Determine if this patient is ODS and if software is on
  1. ;
  1. ;input DFN
  1. ;output: DGODS - 1 if yes, 0 if no
  1. ;
  1. ;
  1. ODS D ON I 'DGODS Q
  1. S DGODS=0 I $D(^DPT(DFN,.32)),$D(^DIC(21,+$P(^(.32),"^",3),0)),($P(^(0),"^",3)=6) S DGODS=1
  1. Q
  1. ;
  1. ON ;is the ODS software turned on?
  1. ;
  1. D ON^A1B2UTL S DGODS=A1B2ODS
  1. K A1B2ODS Q
  1. ;
  1. ;
  1. PT ;pass in DFN from register/admit. If it doesn't exist, create a new entry.
  1. ;pass back DGODS=ifn of file
  1. ;
  1. ; INPUT DFN
  1. ;
  1. ; used: DGONLY - means only ods patients (do software and patient
  1. ; checks if 1, just software checks if 0...for
  1. ; displaced vets)
  1. ;
  1. N DGONLY S DGONLY=1
  1. PT1 N DA,DIC,DIK,SSN,X,Y
  1. I 'DFN!'$D(^DPT(DFN,0)) Q
  1. I $D(DGONLY) D ODS I 'DGODS Q
  1. I '$D(DGONLY) D ON I 'DGODS Q
  1. S DGODS=$O(^A1B2(11500.1,"AD",DFN,0)) I DGODS,$D(^A1B2(11500.1,DGODS,0)) Q
  1. S X(0)=^DPT(DFN,0),SSN=$P(X(0),"^",9) I SSN'?9N.E!($L(SSN)<9)!($L(SSN)>10) Q
  1. ;
  1. S X=SSN,DIC="^A1B2(11500.1,",DIC(0)="L"
  1. K DD,DO D FILE^DICN S DGODS=+Y Q:Y'>0
  1. F I=.32,"ODS" S X(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
  1. D FAC^A1B2UTL
  1. 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
  1. 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:"")
  1. S ^A1B2(11500.1,DGODS,1)=2
  1. S DA=DGODS,DIK=DIC D IX1^DIK
  1. Q
  1. ;
  1. ;
  1. DFN ;Called from admit templates to N DFN
  1. N DFN S DFN=$P(^DGPM(DA,0),"^",3)
  1. D ODS
  1. Q