- 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 Feb 19, 2025@00:21:04 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
