DGYZODS.m

DGYZODS ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91

 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 ;

 ;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

DGYZODS   ;ALB/MIR - UTILITIES FOR ODS SOFTWARE ; 11 JAN 91

 +1       ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21

 +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