Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BDGPAR

BDGPAR.m

Go to the documentation of this file.
  1. BDGPAR ; IHS/ANMC/LJF - CALLS FOR ADT PARAMETERS ; [ 06/16/2003 2:41 PM ]
  1. ;;5.3;PIMS;**1011,1012**;APR 26, 2002
  1. ;
  1. DIV(SITE) ;EP; set ADT division based on DUZ(2)
  1. NEW X,Y
  1. S (X,Y)=0 F S X=$O(^BDGPAR(X)) Q:'X Q:Y D
  1. . ;I $D(^DG(40.8,"C",DUZ(2),X)) S Y=X ;cmi/maw 9/1/09 orig line PATCH 1011
  1. . I $D(^DG(40.8,"AD",DUZ(2),X)) S Y=X ;cmi/maw 9/1/09 mod line PATCH 1011
  1. Q Y
  1. ;
  1. LOCKED(DIV,DATE) ;EP; return 1 if movement is locked (too old for edit)
  1. NEW X
  1. S X=$$GET1^DIQ(9009020.1,DIV,.02) ;census lockout # of days
  1. I $$FMADD^XLFDT(DT,-X)>DATE Q 1
  1. Q 0
  1. ;
  1. OUTPT(SITE) ;EP; returns 1 if site is outpatient only
  1. ; SITE=DUZ(2)
  1. Q +$$GET1^DIQ(40.8,$$DIV(SITE),3,"I")
  1. ;
  1. ACTWD(W) ;EP; returns 1 if ward is active
  1. NEW X S X=$$GET1^DIQ(9009016.5,W,.03,"I")
  1. Q $S(X="I":0,1:1)
  1. ;
  1. ICU(IEN) ;EP; returns 1 if movement IEN was to an ICU ward
  1. NEW X
  1. S X=$$GET1^DIQ(405,IEN,.06,"I") ;ward ien
  1. Q $S($$GET1^DIQ(9009016.5,+X,101)="YES":1,1:0)
  1. ;
  1. ACTSRV(S,DATE) ;EP; returns 1 if service is active on date sent
  1. NEW LAST,IEN
  1. I $$GET1^DIQ(45.7,S,9999999.03)'="YES" Q 0
  1. S LAST=$O(^DIC(45.7,S,"E","B",DATE+1),-1) I 'LAST Q 0
  1. S IEN=$O(^DIC(45.7,S,"E","B",LAST,0)) I 'IEN Q 0
  1. Q $S($P($G(^DIC(45.7,S,"E",IEN,0)),U,2)=1:1,1:0)
  1. ;
  1. ADULT() ;EP; returns minimum age for adult patients
  1. Q $$GET1^DIQ(9009020.1,+$$DIV(DUZ(2)),.05)
  1. ;
  1. ACTHS(N) ;EP; returns 1 if hospital service active and clinical today
  1. I $$GET1^DIQ(49,N,1.7)'="PATIENT CARE" Q 0 ;not clinical
  1. NEW X S X=$O(^DIC(49,N,3,""),-1) I 'X Q 1 ;never closed
  1. I $P($G(^DIC(49,N,3,X,0)),U,2)="" Q 0 ;never reopened
  1. I $P($G(^DIC(49,N,3,X,0)),U,2)>DT Q 0 ;reopen in future
  1. Q 1 ;reopened