BDGBEDA.m

BDGBEDA ; IHS/ANMC/LJF - BED AVAILABILITY BROWSE MODE ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

EN ; -- main entry point for BDG BED AVAIL

 NEW VALMCNT

 D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BDG BED AVAIL")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 Q

 ;

INIT ; -- init variables and list array

 K ^TMP("BDGBEDA",$J),^TMP("BDGBEDA1",$J)

 D GUIR^XBLM("PR^DGPMRBA1","^TMP(""BDGBEDA1"",$J,")

 S X=0 F  S X=$O(^TMP("BDGBEDA1",$J,X)) Q:'X  D

 . S VALMCNT=X

 . S ^TMP("BDGBEDA",$J,X,0)=^TMP("BDGBEDA1",$J,X)

 ;

 I '$D(^TMP("BDGBEDA",$J)) S VALMCNT=1,^TMP("BDGBEDA",$J,1,0)="No data found"

 K ^TMP("BDGBEDA1",$J)

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BDGBEDA",$J)

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BDGBEDA   ; IHS/ANMC/LJF - BED AVAILABILITY BROWSE MODE ; 

 +1       ;;5.3;PIMS;;APR 26, 2002

 +2       ;

EN        ; -- main entry point for BDG BED AVAIL

 +1        NEW VALMCNT

 +2        DO TERM^VALM0

           DO CLEAR^VALM1

 +3        DO EN^VALM("BDG BED AVAIL")

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ; -- header code

 +1        QUIT 

 +2       ;

INIT      ; -- init variables and list array

 +1        KILL ^TMP("BDGBEDA",$JOB),^TMP("BDGBEDA1",$JOB)

 +2        DO GUIR^XBLM("PR^DGPMRBA1","^TMP(""BDGBEDA1"",$J,")

 +3        SET X=0

           FOR 

               SET X=$ORDER(^TMP("BDGBEDA1",$JOB,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +4                SET VALMCNT=X

 +5                SET ^TMP("BDGBEDA",$JOB,X,0)=^TMP("BDGBEDA1",$JOB,X)

               End DoDot:1

 +6       ;

 +7        IF '$DATA(^TMP("BDGBEDA",$JOB))

               SET VALMCNT=1

               SET ^TMP("BDGBEDA",$JOB,1,0)="No data found"

 +8        KILL ^TMP("BDGBEDA1",$JOB)

 +9        QUIT 

 +10      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BDGBEDA",$JOB)

 +2        QUIT 

 +3       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;