DGYZODS ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91
;;5.3;Registration;;Aug 13, 1993
;
;Determine if this patient is ODS and if software is on
;
;input DFN
;output: DGODS - 1 if yes, 0 if no
;
;
ODS D ON I 'DGODS Q
S DGODS=0 I $D(^DPT(DFN,.32)),$D(^DIC(21,+$P(^(.32),"^",3),0)),($P(^(0),"^",3)=6) S DGODS=1
Q
;
ON ;is the ODS software turned on?
;
D ON^A1B2UTL S DGODS=A1B2ODS
K A1B2ODS Q
;
;
PT ;pass in DFN from register/admit. If it doesn't exist, create a new entry.
;pass back DGODS=ifn of file
;
; INPUT DFN
;
; used: DGONLY - means only ods patients (do software and patient
; checks if 1, just software checks if 0...for
; displaced vets)
;
N DGONLY S DGONLY=1
PT1 N DA,DIC,DIK,SSN,X,Y
I 'DFN!'$D(^DPT(DFN,0)) Q
I $D(DGONLY) D ODS I 'DGODS Q
I '$D(DGONLY) D ON I 'DGODS Q
S DGODS=$O(^A1B2(11500.1,"AD",DFN,0)) I DGODS,$D(^A1B2(11500.1,DGODS,0)) Q
S X(0)=^DPT(DFN,0),SSN=$P(X(0),"^",9) I SSN'?9N.E!($L(SSN)<9)!($L(SSN)>10) Q
;
S X=SSN,DIC="^A1B2(11500.1,",DIC(0)="L"
K DD,DO D FILE^DICN S DGODS=+Y Q:Y'>0
F I=.32,"ODS" S X(I)=$S($D(^DPT(DFN,I)):^(I),1:"")
D FAC^A1B2UTL
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
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:"")
S ^A1B2(11500.1,DGODS,1)=2
S DA=DGODS,DIK=DIC D IX1^DIK
Q
;
;
DFN ;Called from admit templates to N DFN
N DFN S DFN=$P(^DGPM(DA,0),"^",3)
D ODS
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGYZODS 1778 printed Dec 13, 2024@03:00:49 Page 2
DGYZODS ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
+3 ;Determine if this patient is ODS and if software is on
+4 ;
+5 ;input DFN
+6 ;output: DGODS - 1 if yes, 0 if no
+7 ;
+8 ;
ODS DO ON
IF 'DGODS
QUIT
+1 SET DGODS=0
IF $DATA(^DPT(DFN,.32))
IF $DATA(^DIC(21,+$PIECE(^(.32),"^",3),0))
IF ($PIECE(^(0),"^",3)=6)
SET DGODS=1
+2 QUIT
+3 ;
ON ;is the ODS software turned on?
+1 ;
+2 DO ON^A1B2UTL
SET DGODS=A1B2ODS
+3 KILL A1B2ODS
QUIT
+4 ;
+5 ;
PT ;pass in DFN from register/admit. If it doesn't exist, create a new entry.
+1 ;pass back DGODS=ifn of file
+2 ;
+3 ; INPUT DFN
+4 ;
+5 ; used: DGONLY - means only ods patients (do software and patient
+6 ; checks if 1, just software checks if 0...for
+7 ; displaced vets)
+8 ;
+9 NEW DGONLY
SET DGONLY=1
PT1 NEW DA,DIC,DIK,SSN,X,Y
+1 IF 'DFN!'$DATA(^DPT(DFN,0))
QUIT
+2 IF $DATA(DGONLY)
DO ODS
IF 'DGODS
QUIT
+3 IF '$DATA(DGONLY)
DO ON
IF 'DGODS
QUIT
+4 SET DGODS=$ORDER(^A1B2(11500.1,"AD",DFN,0))
IF DGODS
IF $DATA(^A1B2(11500.1,DGODS,0))
QUIT
+5 SET X(0)=^DPT(DFN,0)
SET SSN=$PIECE(X(0),"^",9)
IF SSN'?9N.E!($LENGTH(SSN)<9)!($LENGTH(SSN)>10)
QUIT
+6 ;
+7 SET X=SSN
SET DIC="^A1B2(11500.1,"
SET DIC(0)="L"
+8 KILL DD,DO
DO FILE^DICN
SET DGODS=+Y
if Y'>0
QUIT
+9 FOR I=.32,"ODS"
SET X(I)=$SELECT($DATA(^DPT(DFN,I)):^(I),1:"")
+10 DO FAC^A1B2UTL
+11 SET ^A1B2(11500.1,DGODS,0)=SSN_"^"_$PIECE(X(0),"^",1)_"^"_$PIECE(X(0),"^",3)_"^"_$PIECE(X(.32),"^",5)_"^"_$PIECE(X("ODS"),"^",3)_"^"_...
... $PIECE(X("ODS"),"^",2)_"^"_$SELECT($DATA(^DPT(DFN,"DAC")):$PIECE(^("DAC"),"^",1),1:"")_"^"_$SELECT($DATA(DGONLY):1,1:0)_"^^^^"_DFN_"^"_A1B2FN
+12 SET ^A1B2(11500.1,DGODS,.11)=$SELECT($DATA(^DPT(DFN,.11)):^(.11),1:"")
SET X=^(.11)
SET $PIECE(^A1B2(11500.1,DGODS,.11),"^",7)=$SELECT($DATA(^DIC(5,+$PIECE(X,"^",5),1,+$PIECE(X,"^",7),0)):$PIECE(^(0),"^",1),1:"")
+13 SET ^A1B2(11500.1,DGODS,1)=2
+14 SET DA=DGODS
SET DIK=DIC
DO IX1^DIK
+15 QUIT
+16 ;
+17 ;
DFN ;Called from admit templates to N DFN
+1 NEW DFN
SET DFN=$PIECE(^DGPM(DA,0),"^",3)
+2 DO ODS
+3 QUIT
