DGACT.m

DGACT ;ALB/CAW - Active check for facility TS or Specialty ; 7/27/94

 ;;5.3;Registration;**64,683,729,1015**;Aug 13, 1993;Build 21

 ;IHS/ANMC/LJF  5/17/2001 added IHS check for admitting services

 ;

 ;

ACTIVE(FILE,IEN,DGDT) ; Extrinsic function to determine if TS entry is active

 ;

 ;     Input -- FILE to determine if checking facility TS or TS

 ;                  FACILITY TREATING SPECIALTY (45.7)

 ;                  SPECIALTY (42.4)

 ;          IEN is the internal IFN of whichever file passed in

 ;       DGDT as 'as of' date (uses DT if undefined)

 ;    Output -- 1 if active, 0 otherwise

 ;

 N DGID,Y,X

 S DGID=$S($G(DGDT):DGDT,1:DT)

 S DGID=$S('$P(DGID,".",2):(DGID)_.2359,1:(DGID)),DGID=-DGID

 S Y=0

 S ID=$O(^DIC(FILE,IEN,"E","ADATE",DGID)) G:'ID ACTIVEQ

 S ID=$O(^DIC(FILE,IEN,"E","ADATE",ID,0))

 S X=$G(^DIC(FILE,IEN,"E",ID,0)) I 'X G ACTIVEQ

 I $P(X,"^",2)=1 S Y=1

 ;IHS/ANMC/LJF 5/17/01 check if IHS admitting service

 I FILE=45.7,$P($G(^DIC(FILE,IEN,9999999)),U,3)'="Y" S Y=0

ACTIVEQ Q $S(Y:1,1:0)

 ;

TSDATA(FILE,IEN,ARRAY,DGDT) ; Call to return TS data

 ;

 ;     Input -- FILE to determine if checking facility TS or TS

 ;                  FACILITY TREATING SPECIALTY (45.7)

 ;                  SPECIALTY (42.4)

 ;          IEN is the internal IFN of whichever file passed in

 ;       DGDT as 'as of' date (uses DT if undefined)

 ;    Output -- 1 if entry exists, -1 otherwise

 ;** Responsibility of calling routine to handle undefined array when -1

 ;       ARRAY(0) := 1 if active, 0 otherwise

 ;       If FILE=45.7

 ;         ARRAY(1) := Name

 ;         ARRAY(2) := Specialty ptr to 42.4 file^Specialty name

 ;         ARRAY(3) := Abbreviation

 ;         ARRAY(4) := Service ptr to 49 file^Service name

 ;       If FILE=42.4

 ;         ARRAY(1) := Name

 ;         ARRAY(2) := Print name

 ;         ARRAY(3) := Service (set value)^Service (set value) name

 ;         ARRAY(4) := Ask Psychiatric Question? (set value)^null/yes/no

 ;         ARRAY(5) := Billing Rate Bedsection^

 ;         ARRAY(6) := MPCR Account

 ;         ARRAY(7) := PTF Code (alpha-numeric)

 ;

 ;

 K ARRAY N DGI

 S FILE=$G(FILE),IEN=$G(IEN),DGDT=$G(DGDT)

 I '$D(^DIC(FILE,+$G(IEN),0)) Q -1

 I FILE=45.7 D

 . F DGI=0:1:4 S ARRAY(DGI)=""

 . S ARRAY(0)=$$ACTIVE(FILE,IEN,DGDT)

 . S ARRAY(1)=$$GET1^DIQ(45.7,IEN_",",.01)

 . S ARRAY(2)=$$GET1^DIQ(45.7,IEN_",",1,"I")_"^"_$$GET1^DIQ(45.7,IEN_",",1)

 . S ARRAY(3)=$$GET1^DIQ(45.7,IEN_",",99)

 . S ARRAY(4)=$$GET1^DIQ(45.7,IEN_",",2,"I")_"^"_$$GET1^DIQ(45.7,IEN_",",2)

 I FILE=42.4 D

 . F DGI=1:1:7 S ARRAY(DGI)=""

 . S ARRAY(0)=$$ACTIVE(FILE,IEN,DGDT)

 . S ARRAY(1)=$$GET1^DIQ(42.4,IEN_",",.01)

 . S ARRAY(2)=$$GET1^DIQ(42.4,IEN_",",1)

 . S ARRAY(3)=$$GET1^DIQ(42.4,IEN_",",3,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",3)

 . S ARRAY(4)=$$GET1^DIQ(42.4,IEN_",",4,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",4)

 . S ARRAY(5)=$$GET1^DIQ(42.4,IEN_",",5,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",5)

 . S ARRAY(6)=$$GET1^DIQ(42.4,IEN_",",6)

 . S ARRAY(7)=$$GET1^DIQ(42.4,IEN_",",7)

TSDATAQ Q 1

DGACT     ;ALB/CAW - Active check for facility TS or Specialty ; 7/27/94

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

 +2       ;IHS/ANMC/LJF  5/17/2001 added IHS check for admitting services

 +3       ;

 +4       ;

ACTIVE(FILE,IEN,DGDT) ; Extrinsic function to determine if TS entry is active

 +1       ;

 +2       ;     Input -- FILE to determine if checking facility TS or TS

 +3       ;                  FACILITY TREATING SPECIALTY (45.7)

 +4       ;                  SPECIALTY (42.4)

 +5       ;          IEN is the internal IFN of whichever file passed in

 +6       ;       DGDT as 'as of' date (uses DT if undefined)

 +7       ;    Output -- 1 if active, 0 otherwise

 +8       ;

 +9        NEW DGID,Y,X

 +10       SET DGID=$SELECT($GET(DGDT):DGDT,1:DT)

 +11       SET DGID=$SELECT('$PIECE(DGID,".",2):(DGID)_.2359,1:(DGID))

           SET DGID=-DGID

 +12       SET Y=0

 +13       SET ID=$ORDER(^DIC(FILE,IEN,"E","ADATE",DGID))

           IF 'ID

               GOTO ACTIVEQ

 +14       SET ID=$ORDER(^DIC(FILE,IEN,"E","ADATE",ID,0))

 +15       SET X=$GET(^DIC(FILE,IEN,"E",ID,0))

           IF 'X

               GOTO ACTIVEQ

 +16       IF $PIECE(X,"^",2)=1

               SET Y=1

 +17      ;IHS/ANMC/LJF 5/17/01 check if IHS admitting service

 +18       IF FILE=45.7

               IF $PIECE($GET(^DIC(FILE,IEN,9999999)),U,3)'="Y"

                   SET Y=0

ACTIVEQ    QUIT $SELECT(Y:1,1:0)

 +1       ;

TSDATA(FILE,IEN,ARRAY,DGDT) ; Call to return TS data

 +1       ;

 +2       ;     Input -- FILE to determine if checking facility TS or TS

 +3       ;                  FACILITY TREATING SPECIALTY (45.7)

 +4       ;                  SPECIALTY (42.4)

 +5       ;          IEN is the internal IFN of whichever file passed in

 +6       ;       DGDT as 'as of' date (uses DT if undefined)

 +7       ;    Output -- 1 if entry exists, -1 otherwise

 +8       ;** Responsibility of calling routine to handle undefined array when -1

 +9       ;       ARRAY(0) := 1 if active, 0 otherwise

 +10      ;       If FILE=45.7

 +11      ;         ARRAY(1) := Name

 +12      ;         ARRAY(2) := Specialty ptr to 42.4 file^Specialty name

 +13      ;         ARRAY(3) := Abbreviation

 +14      ;         ARRAY(4) := Service ptr to 49 file^Service name

 +15      ;       If FILE=42.4

 +16      ;         ARRAY(1) := Name

 +17      ;         ARRAY(2) := Print name

 +18      ;         ARRAY(3) := Service (set value)^Service (set value) name

 +19      ;         ARRAY(4) := Ask Psychiatric Question? (set value)^null/yes/no

 +20      ;         ARRAY(5) := Billing Rate Bedsection^

 +21      ;         ARRAY(6) := MPCR Account

 +22      ;         ARRAY(7) := PTF Code (alpha-numeric)

 +23      ;

 +24      ;

 +25       KILL ARRAY

           NEW DGI

 +26       SET FILE=$GET(FILE)

           SET IEN=$GET(IEN)

           SET DGDT=$GET(DGDT)

 +27       IF '$DATA(^DIC(FILE,+$GET(IEN),0))

               QUIT -1

 +28       IF FILE=45.7

               Begin DoDot:1

 +29               FOR DGI=0:1:4

                       SET ARRAY(DGI)=""

 +30               SET ARRAY(0)=$$ACTIVE(FILE,IEN,DGDT)

 +31               SET ARRAY(1)=$$GET1^DIQ(45.7,IEN_",",.01)

 +32               SET ARRAY(2)=$$GET1^DIQ(45.7,IEN_",",1,"I")_"^"_$$GET1^DIQ(45.7,IEN_",",1)

 +33               SET ARRAY(3)=$$GET1^DIQ(45.7,IEN_",",99)

 +34               SET ARRAY(4)=$$GET1^DIQ(45.7,IEN_",",2,"I")_"^"_$$GET1^DIQ(45.7,IEN_",",2)

               End DoDot:1

 +35       IF FILE=42.4

               Begin DoDot:1

 +36               FOR DGI=1:1:7

                       SET ARRAY(DGI)=""

 +37               SET ARRAY(0)=$$ACTIVE(FILE,IEN,DGDT)

 +38               SET ARRAY(1)=$$GET1^DIQ(42.4,IEN_",",.01)

 +39               SET ARRAY(2)=$$GET1^DIQ(42.4,IEN_",",1)

 +40               SET ARRAY(3)=$$GET1^DIQ(42.4,IEN_",",3,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",3)

 +41               SET ARRAY(4)=$$GET1^DIQ(42.4,IEN_",",4,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",4)

 +42               SET ARRAY(5)=$$GET1^DIQ(42.4,IEN_",",5,"I")_"^"_$$GET1^DIQ(42.4,IEN_",",5)

 +43               SET ARRAY(6)=$$GET1^DIQ(42.4,IEN_",",6)

 +44               SET ARRAY(7)=$$GET1^DIQ(42.4,IEN_",",7)

               End DoDot:1

TSDATAQ    QUIT 1