BDGVAH.m

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       ;