Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BSDWLL

BSDWLL.m

Go to the documentation of this file. 
  1. BSDWLL ; IHS/ITSC/LJF, WAR - WAITING LIST LT CODE ;  [ 08/20/2004  11:59 AM ]
  1.  ;;5.3;PIMS;**1001,1004,1007**;MAY 28, 2004
  1.  ;IHS/ITSC/WAR 04/27/2004 PATCH 1001 ending date missing in loop
  1.  ;IHS/OIT/LJF  07/20/2005 PATCH 1004 added comments, subtotals & total to list display
  1.  ;                                   added ability to print sort categories on separate pages
  1.  ;cmi/anch/maw 01/15/2007 PATCH 1007 added screen of print by if defined item 1007.28
  1.  ;
  1. EN ;EP -- main entry point for BSDRM WAITING LIST
  1.  I $E(IOST,1,2)'="C-" D INIT,PRINT Q    ;printing to paper
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM WAITING LIST")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  S X="Waiting List for "_$$GET1^DIQ(9009017.1,BSDWLN,.01)
  1.  S VALMHDR(2)=$$SP(70-$L(X)\2)_X
  1.  S X="Sorted by "_$$FIELD(9009017.11,$P(BSDSRT,U,2))
  1.  S X=X_"; for "_$P(BSDATE,U,2)
  1.  S VALMHDR(3)=$$SP(70-$L(X)\2)_X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDWL",$J),^TMP("BSDWL1",$J)
  1.  ;
  1.  ; search by date range and sort
  1.  NEW BSDSUB,BSDT,BSDN,BSDTPRI,BSDTPROV,BSDTREA,BSDTRES  ;cmi/maw added variables for PATCH 1007 item 1007.28
  1.  S BSDSUB=$S(+BSDATE=".03":"AC",+BSDATE=".05":"AD",1:"AE")
  1.  S BSDT=BSDBD-.0001
  1.  F  S BSDT=$O(^BSDWL(BSDSUB,BSDT)) Q:'BSDT!(BSDT'<(BSDED+.9999))  D
  1.  . S BSDN=0 F  S BSDN=$O(^BSDWL(BSDSUB,BSDT,BSDWLN,BSDN)) Q:'BSDN  D
  1.  .. ;cmi/anch/maw 1/15/2007 added below lines to filter on print by
  1.  .. I $G(BSDPRTYN),$G(BSDPRTB)=2 S BSDTPRI=$P($G(^BSDWL(BSDWLN,1,BSDN,0)),U,2) Q:'$D(BSDPRI(BSDTPRI))
  1.  .. I $G(BSDPRTYN),$G(BSDPRTB)=3 S BSDTPROV=$P($G(^BSDWL(BSDWLN,1,BSDN,0)),U,6) Q:'$D(BSDPROV(BSDTPROV))
  1.  .. I $G(BSDPRTYN),$G(BSDPRTB)=4 S BSDTREA=$P($G(^BSDWL(BSDWLN,1,BSDN,0)),U,9) Q:'$D(BSDREA(BSDTREA))
  1.  .. I $G(BSDPRTYN),$G(BSDPRTB)=5 S BSDTRES=$P($G(^BSDWL(BSDWLN,1,BSDN,0)),U,8) Q:'$D(BSDRES(BSDTRES))
  1.  .. ;cmi/anch/maw 1/15/2007 end of mods
  1.  .. I BSDREM=0,$P($G(^BSDWL(BSDWLN,1,BSDN,0)),U,7)]"" Q  ;removed
  1.  .. S ^TMP("BSDWL1",$J,$$SORT(BSDWLN,BSDN),BSDT,BSDN)=""
  1.  ;
  1.  ; take sorted list and put into display array
  1.  NEW A,B,C,LINE,DFN,BSDCNT,FIRST,X
  1.  NEW BSDATA,IENS,FILE,SUBCNT,TOTAL   ;IHS/OIT/LJF 7/21/2005 PATCH 1004 new variables
  1.  S FIRST=1
  1.  S A=0 F  S A=$O(^TMP("BSDWL1",$J,A)) Q:A=""  D
  1.  . ;
  1.  . ; display sort heading
  1.  . ;IHS/OIT/LJF 7/21/2005 PATCH 1004 add ability to print each sort on separate page
  1.  . ;I 'FIRST D SET("","",+$G(BSDCNT),.VALMCNT)
  1.  . I 'FIRST D
  1.  . . I $G(BSDPAG) D SET("NEW PAGE HERE","",+$G(BSDCNT),.VALMCNT) Q
  1.  . . D SET("","",+$G(BSDCNT),.VALMCNT)
  1.  . ;end of PATCH 1004 changes
  1.  . ;
  1.  . S FIRST=0
  1.  . S X=$S(+BSDSRT=1:$$FMTE^XLFDT(A),1:A)   ;printable sort
  1.  . S LINE=$$SP(10)_"** "_$$FIELD(9009017.11,$P(BSDSRT,U,2))_": "_X_" **"
  1.  . D SET(LINE,"",+$G(BSDCNT),.VALMCNT)
  1.  . ;
  1.  . ; loop through date and ien
  1.  . S B=0 F  S B=$O(^TMP("BSDWL1",$J,A,B)) Q:'B  D
  1.  .. S C=0 F  S C=$O(^TMP("BSDWL1",$J,A,B,C)) Q:'C  D
  1.  ... ;
  1.  ... ; create display line
  1.  ... S DFN=+^BSDWL(BSDWLN,1,C,0)                                ;patient ien
  1.  ... S BSDCNT=$G(BSDCNT)+1,LINE=$J(BSDCNT,3)_". "_$$FMTE^XLFDT(B)
  1.  ... S LINE=$$PAD(LINE,20)_$E($$GET1^DIQ(2,DFN,.01),1,20)       ;patient name
  1.  ... S LINE=$$PAD(LINE,42)_$J($$HRCN^BDGF2(DFN,+$G(DUZ(2))),6)  ;hrcn
  1.  ... S LINE=$$PAD(LINE,52)_$J($$GET1^DIQ(2,DFN,.033),3)         ;age
  1.  ... S LINE=$$PAD(LINE,60)_$$GET1^DIQ(2,DFN,.02,"I")            ;sex
  1.  ... ;S LINE=$$PAD(LINE,66)_$$GET1^DIQ(2,DFN,.131)   ;home phone
  1.  ... S LINE=$$PAD(LINE,64)_$$GET1^DIQ(2,DFN,.131)    ;IHS/OIT/LJF 7/21/2005 PATCH 1004 improved spacing
  1.  ... ;
  1.  ... ; and set into display array
  1.  ... D SET(LINE,C,BSDCNT,.VALMCNT)
  1.  ... ;
  1.  ... ;IHS/OIT/LJF 7/21/2005 PATCH 1004 added comments to listing & subcounts
  1.  ... K BSDATA S IENS=C_","_BSDWLN_",",FILE=9009017.11
  1.  ... D GETS^DIQ(FILE,IENS,"1","R","BSDATA")
  1.  ... S X=0 F  S X=$O(BSDATA(FILE,IENS,"COMMENTS",X)) Q:'X  D
  1.  .... D SET($$SP(6)_BSDATA(FILE,IENS,"COMMENTS",X),C,BSDCNT,.VALMCNT)
  1.  ... D SET(" ",C,BSDCNT,.VALMCNT)
  1.  ... ;
  1.  ... S SUBCNT(A)=$G(SUBCNT(A))+1,TOTAL=$G(TOTAL)+1    ;increment counts
  1.  . ; add subcount to display
  1.  . D SET("Subtotal for "_$S(+BSDSRT=1:$$FMTE^XLFDT(A),1:A)_":  "_$G(SUBCNT(A)),C,BSDCNT,.VALMCNT)
  1.  ;
  1.  I $G(TOTAL) D SET("Total on list:  "_TOTAL,"",BSDCNT,.VALMCNT)
  1.  ;end of PATCH 1004 additions
  1.  ;
  1.  I VALMCNT=0 D SET($$SP(20)_"No Data Found","",0,.VALMCNT)
  1.  K ^TMP("BSDWL1",$J)
  1.  Q
  1.  ;
  1. SORT(CLN,IEN) ; set sort value for ^tmp
  1.  NEW X
  1.  S X=$$GET1^DIQ(9009017.11,IEN_","_CLN,$P(BSDSRT,U,2))
  1.  I +BSDSRT=1 S X=$$GET1^DIQ(9009017.11,IEN_","_CLN,$P(BSDSRT,U,2),"I")
  1.  Q $S(X="":"UNKNOWN",1:X)
  1.  ;
  1. SET(DATA,IEN,COUNT,NUM) ; puts data line into display array
  1.  S NUM=NUM+1 S:COUNT=0 COUNT=1
  1.  S ^TMP("BSDWL",$J,NUM,0)=DATA
  1.  S ^TMP("BSDWL",$J,"IDX",NUM,COUNT)=IEN
  1.  Q
  1.  ;
  1. PRINT ; print report to paper
  1.  U IO D HDG
  1.  NEW LINE
  1.  S LINE=0 F  S LINE=$O(^TMP("BSDWL",$J,LINE)) Q:'LINE  D
  1.  . I ^TMP("BSDWL",$J,LINE,0)="NEW PAGE HERE" D HDG Q  ;IHS/OIT/LJF 7/21/2005 PATCH 1004
  1.  . I $Y>(IOSL-4) D HDG
  1.  . W !,^TMP("BSDWL",$J,LINE,0)
  1.  D ^%ZISC,EXIT
  1.  Q
  1.  ;
  1. HDG ; heading for paper report
  1.  D HDR W @IOF
  1.  NEW I F I=1:1 Q:'$D(VALMHDR(I))  W !,VALMHDR(I)
  1.  W !,$$REPEAT^XLFSTR("-",80)
  1.  ;
  1.  ;IHS/OIT/LJF 7/21/2005 PATCH 1004 improved column heading spacing
  1.  ;W !?6,"Date Selected",?21,"Patient Name",?42,"Chart #",?53,"Age"
  1.  ;W ?60,"Sex",?65,"Home Phone"
  1.  W !?5,"Date Selected",?20,"Patient Name",?42,"Chart #",?52,"Age"
  1.  W ?59,"Sex",?64,"Home Phone"
  1.  ;
  1.  W !,$$REPEAT^XLFSTR("=",80)
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDWL",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. GETONE ; -- select entry from listing
  1.  NEW X,Y,Z
  1.  D FULL^VALM1
  1.  S BSDN=""
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) Q
  1.  S X=$O(VALMY(0))
  1.  S Y=0 F  S Y=$O(^TMP("BSDWL",$J,"IDX",Y)) Q:Y=""  Q:BSDN]""  D
  1.  . S Z=$O(^TMP("BSDWL",$J,"IDX",Y,0))
  1.  . Q:^TMP("BSDWL",$J,"IDX",Y,Z)=""
  1.  . I Z=X S BSDN=^TMP("BSDWL",$J,"IDX",Y,Z)
  1.  Q
  1.  ;
  1. VIEW ;EP; called by BSDRM WAIT LIST VIEW protocol
  1.  NEW BSDN,DFN
  1.  D GETONE I BSDN="" D RETURN Q
  1.  S DFN=+$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,.01,"I")  ;line added
  1.  D EN^BSDWLV,RETURN
  1.  Q
  1.  ;
  1. RETURN ; -- reset variables for return to lt
  1.  D TERM^VALM0 S VALMBCK="R" Q
  1.  ;
  1. FIELD(F,N) ; find field's name
  1.  Q $P($G(^DD(F,N,0)),U)
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)