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