DGREGFAC ;BAY/JT; 12/18/03 8:16am ; 12/18/03 9:55am
;;5.3;Registration;**574**;Aug 13, 1993
DIVCHK(DFN,DFN1) ; call to validate 'facility applying to' (division)
; DFN = ien of patient file
; DFN1 = ien of Disposition multiple
; returns 1 if division is inactive, 0 otherwise
;
N DGDIV,DGINST
I '$G(DFN)!('$G(DFN1)) Q 0
; site not multi-divisional
I $P($G(^DG(43,1,"GL")),U,2)=0 Q 0
; determine division chosen
S DGDIV=$P($G(^DPT(DFN,"DIS",DFN1,0)),U,4)
I DGDIV'>0 Q 0
; division has no pointer to Institution file
I $P($G(^DG(40.8,DGDIV,0)),U,7)'>0 Q 1
S DGINST=$P($G(^DG(40.8,DGDIV,0)),U,7)
; Institution file is inactive
I $P($G(^DIC(4,DGINST,99)),U,4)=1 Q 1
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGREGFAC 704 printed Oct 16, 2024@18:55:35 Page 2
DGREGFAC ;BAY/JT; 12/18/03 8:16am ; 12/18/03 9:55am
+1 ;;5.3;Registration;**574**;Aug 13, 1993
DIVCHK(DFN,DFN1) ; call to validate 'facility applying to' (division)
+1 ; DFN = ien of patient file
+2 ; DFN1 = ien of Disposition multiple
+3 ; returns 1 if division is inactive, 0 otherwise
+4 ;
+5 NEW DGDIV,DGINST
+6 IF '$GET(DFN)!('$GET(DFN1))
QUIT 0
+7 ; site not multi-divisional
+8 IF $PIECE($GET(^DG(43,1,"GL")),U,2)=0
QUIT 0
+9 ; determine division chosen
+10 SET DGDIV=$PIECE($GET(^DPT(DFN,"DIS",DFN1,0)),U,4)
+11 IF DGDIV'>0
QUIT 0
+12 ; division has no pointer to Institution file
+13 IF $PIECE($GET(^DG(40.8,DGDIV,0)),U,7)'>0
QUIT 1
+14 SET DGINST=$PIECE($GET(^DG(40.8,DGDIV,0)),U,7)
+15 ; Institution file is inactive
+16 IF $PIECE($GET(^DIC(4,DGINST,99)),U,4)=1
QUIT 1
+17 QUIT 0
