DGREGFAC.m

DGREGFAC ;BAY/JT; 12/18/03 8:16am ; 12/18/03 9:55am

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

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

DGREGFAC  ;BAY/JT; 12/18/03 8:16am ; 12/18/03 9:55am

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

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