BDGSD.m

BDGSD ; IHS/ANMC/LJF - FUTURE APPTS FOR NEW INPTS ; 

 ;;5.3;PIMS;;APR 26, 2002

 ;

MENU ;EP; choice of inpt appt reports

 NEW REPORT

 S REPORT=$$READ^BDGF("SO^1:Future Appts for New Admissions;2:Appts for Current Inpatients","Select Report to Run")

 Q:REPORT<1

 S X=$S(REPORT=1:"^SDWARD",1:"^BDGSD1") D @X

 Q

 ;

 ;

EN ;EP; -- main entry point for BDG FUTURE APPTS

 ; Called by SDWARD if displaying to screen

 ; Used ADT namespace because option going on ADT menu

 ; Reset SDY from saved variable BDGADT

 ;

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 D EN^VALM("BDG FUTURE APPTS")

 D CLEAR^VALM1

 Q

 ;

HDR ; -- header code

 NEW X

 S VALMHDR(1)=$$SP(10)_"*** "_$$CONF^BDGF_" ***"

 S X="For patients admitted on "_$$FMTE^XLFDT(BDGDT)

 S VALMHDR(2)=$$SP(75-$L(X)\2)_X

 Q

 ;

INIT ; -- init variables and list array

 NEW X

 K ^TMP("BDGSD",$J),^TMP("BDGSDA",$J)

 S SDY=BDGDT

 D GUIR^XBLM("START^SDWARD","^TMP(""BDGSDA"",$J,")

 S (X,VALMCNT)=0

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

 . S ^TMP("BDGSD",$J,X,0)=$G(^TMP("BDGSDA",$J,X))

 . S VALMCNT=VALMCNT+1

 ;

 I VALMCNT=0 S VALMCNT=1,^TMP("BDGSD",$J,1,0)="No Appts Found"

 K ^TMP("BDGSDA",$J)

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BDGSD",$J) K BDGDT

 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)

BDGSD     ; IHS/ANMC/LJF - FUTURE APPTS FOR NEW INPTS ; 

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

 +2       ;

MENU      ;EP; choice of inpt appt reports

 +1        NEW REPORT

 +2        SET REPORT=$$READ^BDGF("SO^1:Future Appts for New Admissions;2:Appts for Current Inpatients","Select Report to Run")

 +3        IF REPORT<1

               QUIT 

 +4        SET X=$SELECT(REPORT=1:"^SDWARD",1:"^BDGSD1")

           DO @X

 +5        QUIT 

 +6       ;

 +7       ;

EN        ;EP; -- main entry point for BDG FUTURE APPTS

 +1       ; Called by SDWARD if displaying to screen

 +2       ; Used ADT namespace because option going on ADT menu

 +3       ; Reset SDY from saved variable BDGADT

 +4       ;

 +5        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +6        DO EN^VALM("BDG FUTURE APPTS")

 +7        DO CLEAR^VALM1

 +8        QUIT 

 +9       ;

HDR       ; -- header code

 +1        NEW X

 +2        SET VALMHDR(1)=$$SP(10)_"*** "_$$CONF^BDGF_" ***"

 +3        SET X="For patients admitted on "_$$FMTE^XLFDT(BDGDT)

 +4        SET VALMHDR(2)=$$SP(75-$LENGTH(X)\2)_X

 +5        QUIT 

 +6       ;

INIT      ; -- init variables and list array

 +1        NEW X

 +2        KILL ^TMP("BDGSD",$JOB),^TMP("BDGSDA",$JOB)

 +3        SET SDY=BDGDT

 +4        DO GUIR^XBLM("START^SDWARD","^TMP(""BDGSDA"",$J,")

 +5        SET (X,VALMCNT)=0

 +6        FOR 

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

               IF 'X

                   QUIT 

               Begin DoDot:1

 +7                SET ^TMP("BDGSD",$JOB,X,0)=$GET(^TMP("BDGSDA",$JOB,X))

 +8                SET VALMCNT=VALMCNT+1

               End DoDot:1

 +9       ;

 +10       IF VALMCNT=0

               SET VALMCNT=1

               SET ^TMP("BDGSD",$JOB,1,0)="No Appts Found"

 +11       KILL ^TMP("BDGSDA",$JOB)

 +12       QUIT 

 +13      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

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

           KILL BDGDT

 +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)