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