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

BDGVAH.m

Go to the documentation of this file.
  1. BDGVAH ; IHS/ANMC/LJF - VIEW ADMISSION HISTORY ;
  1. ;;5.3;PIMS;;APR 26, 2002
  1. ;
  1. EN ; list manager view of patient's admissions
  1. NEW DFN,VALMCNT
  1. S DFN=+$$READ^BDGF("PO^2:EMQZ","Select PATIENT") Q:DFN<1
  1. D TERM^VALM0,CLEAR^VALM1
  1. D EN^VALM("BDG VIEW ADMIT HISTORY")
  1. D CLEAR^VALM1
  1. Q
  1. ;
  1. HDR ;EP; -- header code
  1. S VALMHDR(1)=$$SP(16)_$$CONF^BDGF
  1. NEW X S X=$$GET1^DIQ(2,DFN,.01)_" #"_$$HRCN^BDGF2(DFN,DUZ(2))
  1. S X=X_" DOB: "_$$GET1^DIQ(2,DFN,.03) ;date of birth
  1. S X=X_" ("_$$GET1^DIQ(9000001,DFN,1102.98)_")" ;age
  1. S VALMHDR(2)=$$SP(79-$L(X)\2)_X
  1. S X="Inpatient Status: "_$$STATUS^BDGF2(DFN)
  1. S VALMHDR(3)=$$SP(79-$L(X)\2)_X
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. NEW DATE,ADM,LINE,X
  1. S VALMCNT=0 K ^TMP("BDGVAH",$J)
  1. S DATE=0
  1. F S DATE=$O(^DGPM("APTT1",DFN,DATE)) Q:'DATE D
  1. . S ADM=0
  1. . F S ADM=$O(^DGPM("APTT1",DFN,DATE,ADM)) Q:'ADM D
  1. .. Q:'$D(^DGPM(ADM,0)) ;quit if bad xref
  1. .. S LINE=$$NUMDATE^BDGF(+^DGPM(ADM,0)\1)_" - " ;admit date
  1. .. S X=$$GET1^DIQ(405,ADM,.17,"I") ;discharge node
  1. .. I X S LINE=LINE_$$NUMDATE^BDGF(+$G(^DGPM(X,0))\1) ;discharge date
  1. .. S LINE=$$PAD(LINE,26)_$$WRDABRV2^BDGF1(ADM) ;admit ward
  1. .. S LINE=$$PAD(LINE,36)_$$GET1^DIQ(405,ADM,.07) ;admit room
  1. .. S LINE=$$PAD(LINE,45)_$$ADMSRVC^BDGF1(ADM,DFN) ;admit service
  1. .. S LINE=$$PAD(LINE,56)_$$ADMPRV^BDGF1(ADM,DFN,"ADM") ;admt prov
  1. .. D SET(LINE,.VALMCNT)
  1. ;
  1. I '$D(^TMP("BDGVAH",$J)) D SET("NO ADMISSIONS FOUND",.VALMCNT)
  1. Q
  1. ;
  1. SET(DATA,NUM) ; put display line into array
  1. S NUM=NUM+1
  1. S ^TMP("BDGVAH",$J,NUM,0)=DATA
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("BDGVAH",$J) D KILL^AUPNPAT
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1. ; -- D=data L=length
  1. Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1. ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1. Q $$PAD(" ",N)
  1. ;