BDGPAR.m

BDGPAR ; IHS/ANMC/LJF - CALLS FOR ADT PARAMETERS ;  [ 06/16/2003  2:41 PM ]

 ;;5.3;PIMS;**1011,1012**;APR 26, 2002

 ;

DIV(SITE) ;EP; set ADT division based on DUZ(2)

 NEW X,Y

 S (X,Y)=0 F  S X=$O(^BDGPAR(X)) Q:'X  Q:Y  D

 . ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X  ;cmi/maw 9/1/09 orig line PATCH 1011

 . I $D(^DG(40.8,"AD",DUZ(2),X)) S Y=X  ;cmi/maw 9/1/09 mod line PATCH 1011

 Q Y

 ;

LOCKED(DIV,DATE) ;EP; return 1 if movement is locked (too old for edit)

 NEW X

 S X=$$GET1^DIQ(9009020.1,DIV,.02)   ;census lockout # of days

 I $$FMADD^XLFDT(DT,-X)>DATE Q 1

 Q 0

 ;

OUTPT(SITE) ;EP; returns 1 if site is outpatient only

 ; SITE=DUZ(2)

 Q +$$GET1^DIQ(40.8,$$DIV(SITE),3,"I")

 ;

ACTWD(W) ;EP; returns 1 if ward is active

 NEW X S X=$$GET1^DIQ(9009016.5,W,.03,"I")

 Q $S(X="I":0,1:1)

 ;

ICU(IEN) ;EP; returns 1 if movement IEN was to an ICU ward

 NEW X

 S X=$$GET1^DIQ(405,IEN,.06,"I")           ;ward ien

 Q $S($$GET1^DIQ(9009016.5,+X,101)="YES":1,1:0)

 ;

ACTSRV(S,DATE) ;EP; returns 1 if service is active on date sent

 NEW LAST,IEN

 I $$GET1^DIQ(45.7,S,9999999.03)'="YES" Q 0

 S LAST=$O(^DIC(45.7,S,"E","B",DATE+1),-1) I 'LAST Q 0

 S IEN=$O(^DIC(45.7,S,"E","B",LAST,0)) I 'IEN Q 0

 Q $S($P($G(^DIC(45.7,S,"E",IEN,0)),U,2)=1:1,1:0)

 ;

ADULT() ;EP; returns minimum age for adult patients

 Q $$GET1^DIQ(9009020.1,+$$DIV(DUZ(2)),.05)

 ;

ACTHS(N) ;EP; returns 1 if hospital service active and clinical today

 I $$GET1^DIQ(49,N,1.7)'="PATIENT CARE" Q 0    ;not clinical

 NEW X S X=$O(^DIC(49,N,3,""),-1) I 'X Q 1     ;never closed

 I $P($G(^DIC(49,N,3,X,0)),U,2)="" Q 0         ;never reopened

 I $P($G(^DIC(49,N,3,X,0)),U,2)>DT Q 0         ;reopen in future

 Q 1                                           ;reopened

BDGPAR    ; IHS/ANMC/LJF - CALLS FOR ADT PARAMETERS ;  [ 06/16/2003  2:41 PM ]

 +1       ;;5.3;PIMS;**1011,1012**;APR 26, 2002

 +2       ;

DIV(SITE) ;EP; set ADT division based on DUZ(2)

 +1        NEW X,Y

 +2        SET (X,Y)=0

           FOR 

               SET X=$ORDER(^BDGPAR(X))

               IF 'X

                   QUIT 

               IF Y

                   QUIT 

               Begin DoDot:1

 +3       ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X  ;cmi/maw 9/1/09 orig line PATCH 1011

 +4       ;cmi/maw 9/1/09 mod line PATCH 1011

                   IF $DATA(^DG(40.8,"AD",DUZ(2),X))

                       SET Y=X

               End DoDot:1

 +5        QUIT Y

 +6       ;

LOCKED(DIV,DATE) ;EP; return 1 if movement is locked (too old for edit)

 +1        NEW X

 +2       ;census lockout # of days

           SET X=$$GET1^DIQ(9009020.1,DIV,.02)

 +3        IF $$FMADD^XLFDT(DT,-X)>DATE

               QUIT 1

 +4        QUIT 0

 +5       ;

OUTPT(SITE) ;EP; returns 1 if site is outpatient only

 +1       ; SITE=DUZ(2)

 +2        QUIT +$$GET1^DIQ(40.8,$$DIV(SITE),3,"I")

 +3       ;

ACTWD(W)  ;EP; returns 1 if ward is active

 +1        NEW X

           SET X=$$GET1^DIQ(9009016.5,W,.03,"I")

 +2        QUIT $SELECT(X="I":0,1:1)

 +3       ;

ICU(IEN)  ;EP; returns 1 if movement IEN was to an ICU ward

 +1        NEW X

 +2       ;ward ien

           SET X=$$GET1^DIQ(405,IEN,.06,"I")

 +3        QUIT $SELECT($$GET1^DIQ(9009016.5,+X,101)="YES":1,1:0)

 +4       ;

ACTSRV(S,DATE) ;EP; returns 1 if service is active on date sent

 +1        NEW LAST,IEN

 +2        IF $$GET1^DIQ(45.7,S,9999999.03)'="YES"

               QUIT 0

 +3        SET LAST=$ORDER(^DIC(45.7,S,"E","B",DATE+1),-1)

           IF 'LAST

               QUIT 0

 +4        SET IEN=$ORDER(^DIC(45.7,S,"E","B",LAST,0))

           IF 'IEN

               QUIT 0

 +5        QUIT $SELECT($PIECE($GET(^DIC(45.7,S,"E",IEN,0)),U,2)=1:1,1:0)

 +6       ;

ADULT()   ;EP; returns minimum age for adult patients

 +1        QUIT $$GET1^DIQ(9009020.1,+$$DIV(DUZ(2)),.05)

 +2       ;

ACTHS(N)  ;EP; returns 1 if hospital service active and clinical today

 +1       ;not clinical

           IF $$GET1^DIQ(49,N,1.7)'="PATIENT CARE"

               QUIT 0

 +2       ;never closed

           NEW X

           SET X=$ORDER(^DIC(49,N,3,""),-1)

           IF 'X

               QUIT 1

 +3       ;never reopened

           IF $PIECE($GET(^DIC(49,N,3,X,0)),U,2)=""

               QUIT 0

 +4       ;reopen in future

           IF $PIECE($GET(^DIC(49,N,3,X,0)),U,2)>DT

               QUIT 0

 +5       ;reopened

           QUIT 1