BSDWLE1.m

BSDWLE1 ; IHS/OIT/LJF - WAITING LIST DATA ENTRY - CLOSED CASES

 ;;5.3;PIMS;**1004**;MAY 28, 2004

 ;IHS/OIT/LJF 07/21/2005 PATCH 1004 routine added

 ;

EN ; -- main entry point for BSDRM WAITING LIST CLOSED

 NEW VALMCNT D TERM^VALM0,CLEAR^VALM1

 NEW BSDCLOSE S BSDCLOSE=1

 D EN^VALM("BSDAM WAITING LIST CLOSED")

 D CLEAR^VALM1

 Q

 ;

HDR ;EP -- header code

 NEW X

 S VALMHDR(1)=$$SP(15)_$$CONF^BDGF

 S X=$$GET1^DIQ(9009017.1,BSDWLN,.01)

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

 Q

 ;

INIT ;EP -- init variables and list array

 NEW FILE,IEN,IENS,BSDATA,NAME,BSDCNT,LINE

 S VALMCNT=0 K ^TMP("BSDWLE",$J),^TMP("BSDWLE1",$J)

 ;

 S FILE=9009017.11

 S IEN=0 F  S IEN=$O(^BSDWL(BSDWLN,1,IEN)) Q:'IEN  D

 . S IENS=IEN_","_BSDWLN_","

 . K BSDATA D GETS^DIQ(FILE,IENS,".01;.07","R","BSDATA")

 . I BSDATA(FILE,IENS,"DATE REMOVED FROM LIST")="" Q        ;skip if NOT closed out

 . S ^TMP("BSDWLE1",$J,BSDATA(FILE,IENS,"PATIENT"),IEN)=""  ;sort by patient name

 ;

 ; now take sorted list and build display array

 S NAME=0 F  S NAME=$O(^TMP("BSDWLE1",$J,NAME)) Q:NAME=""  D

 . S IEN=0 F  S IEN=$O(^TMP("BSDWLE1",$J,NAME,IEN)) Q:'IEN  D

 . . S IENS=IEN_","_BSDWLN_"," K BSDATA

 . . D GETS^DIQ(FILE,IENS,".013;.02;.03;.07;.08;1","R","BSDATA")

 . . S BSDCNT=$G(BSDCNT)+1 S LINE=$J(BSDCNT,3)_". "

 . . S LINE=LINE_$$PAD($E(NAME,1,22),24)_BSDATA(FILE,IENS,"HRCN")

 . . S LINE=$$PAD(LINE,37)_BSDATA(FILE,IENS,"DATE ADDED TO LIST")

 . . S LINE=$$PAD(LINE,52)_BSDATA(FILE,IENS,"DATE REMOVED FROM LIST")

 . . S LINE=$$PAD(LINE,67)_BSDATA(FILE,IENS,"PRIORITY")

 . . S LINE=$$PAD(LINE,81)_$E(BSDATA(FILE,IENS,"RESOLUTION"),1,18)

 . . S LINE=$$PAD(LINE,102)_$G(BSDATA(FILE,IENS,"COMMENTS",1))

 . . D SET(LINE,IEN,BSDCNT,.VALMCNT)

 ;

 I VALMCNT=0 S ^TMP("BSDWLE",$J,1,0)="No Closed Cases for this Waiting List",VALMCNT=1

 K ^TMP("BSDWLE1",$J)

 Q

 ;

SET(DATA,IEN,COUNT,LINENUM) ; puts data line into display array

 S LINENUM=LINENUM+1 S:COUNT=0 COUNT=1

 S ^TMP("BSDWLE",$J,LINENUM,0)=DATA

 S ^TMP("BSDWLE",$J,"IDX",LINENUM,COUNT)=IEN

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BSDWLE",$J)

 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)

BSDWLE1   ; IHS/OIT/LJF - WAITING LIST DATA ENTRY - CLOSED CASES

 +1       ;;5.3;PIMS;**1004**;MAY 28, 2004

 +2       ;IHS/OIT/LJF 07/21/2005 PATCH 1004 routine added

 +3       ;

EN        ; -- main entry point for BSDRM WAITING LIST CLOSED

 +1        NEW VALMCNT

           DO TERM^VALM0

           DO CLEAR^VALM1

 +2        NEW BSDCLOSE

           SET BSDCLOSE=1

 +3        DO EN^VALM("BSDAM WAITING LIST CLOSED")

 +4        DO CLEAR^VALM1

 +5        QUIT 

 +6       ;

HDR       ;EP -- header code

 +1        NEW X

 +2        SET VALMHDR(1)=$$SP(15)_$$CONF^BDGF

 +3        SET X=$$GET1^DIQ(9009017.1,BSDWLN,.01)

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

 +5        QUIT 

 +6       ;

INIT      ;EP -- init variables and list array

 +1        NEW FILE,IEN,IENS,BSDATA,NAME,BSDCNT,LINE

 +2        SET VALMCNT=0

           KILL ^TMP("BSDWLE",$JOB),^TMP("BSDWLE1",$JOB)

 +3       ;

 +4        SET FILE=9009017.11

 +5        SET IEN=0

           FOR 

               SET IEN=$ORDER(^BSDWL(BSDWLN,1,IEN))

               IF 'IEN

                   QUIT 

               Begin DoDot:1

 +6                SET IENS=IEN_","_BSDWLN_","

 +7                KILL BSDATA

                   DO GETS^DIQ(FILE,IENS,".01;.07","R","BSDATA")

 +8       ;skip if NOT closed out

                   IF BSDATA(FILE,IENS,"DATE REMOVED FROM LIST")=""

                       QUIT 

 +9       ;sort by patient name

                   SET ^TMP("BSDWLE1",$JOB,BSDATA(FILE,IENS,"PATIENT"),IEN)=""

               End DoDot:1

 +10      ;

 +11      ; now take sorted list and build display array

 +12       SET NAME=0

           FOR 

               SET NAME=$ORDER(^TMP("BSDWLE1",$JOB,NAME))

               IF NAME=""

                   QUIT 

               Begin DoDot:1

 +13               SET IEN=0

                   FOR 

                       SET IEN=$ORDER(^TMP("BSDWLE1",$JOB,NAME,IEN))

                       IF 'IEN

                           QUIT 

                       Begin DoDot:2

 +14                       SET IENS=IEN_","_BSDWLN_","

                           KILL BSDATA

 +15                       DO GETS^DIQ(FILE,IENS,".013;.02;.03;.07;.08;1","R","BSDATA")

 +16                       SET BSDCNT=$GET(BSDCNT)+1

                           SET LINE=$JUSTIFY(BSDCNT,3)_". "

 +17                       SET LINE=LINE_$$PAD($EXTRACT(NAME,1,22),24)_BSDATA(FILE,IENS,"HRCN")

 +18                       SET LINE=$$PAD(LINE,37)_BSDATA(FILE,IENS,"DATE ADDED TO LIST")

 +19                       SET LINE=$$PAD(LINE,52)_BSDATA(FILE,IENS,"DATE REMOVED FROM LIST")

 +20                       SET LINE=$$PAD(LINE,67)_BSDATA(FILE,IENS,"PRIORITY")

 +21                       SET LINE=$$PAD(LINE,81)_$EXTRACT(BSDATA(FILE,IENS,"RESOLUTION"),1,18)

 +22                       SET LINE=$$PAD(LINE,102)_$GET(BSDATA(FILE,IENS,"COMMENTS",1))

 +23                       DO SET(LINE,IEN,BSDCNT,.VALMCNT)

                       End DoDot:2

               End DoDot:1

 +24      ;

 +25       IF VALMCNT=0

               SET ^TMP("BSDWLE",$JOB,1,0)="No Closed Cases for this Waiting List"

               SET VALMCNT=1

 +26       KILL ^TMP("BSDWLE1",$JOB)

 +27       QUIT 

 +28      ;

SET(DATA,IEN,COUNT,LINENUM) ; puts data line into display array

 +1        SET LINENUM=LINENUM+1

           IF COUNT=0

               SET COUNT=1

 +2        SET ^TMP("BSDWLE",$JOB,LINENUM,0)=DATA

 +3        SET ^TMP("BSDWLE",$JOB,"IDX",LINENUM,COUNT)=IEN

 +4        QUIT 

 +5       ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

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

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