- 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
