- 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 Jan 18, 2025@04:01:30 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