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

BSDWLV.m

Go to the documentation of this file. 
  1. BSDWLV ; IHS/ITSC/LJF, WAR - VIEW WAITING LIST ENTRY ; [ 01/09/2003  1:44 PM ]
  1.  ;;5.3;PIMS;**1004,1007,1012**;MAY 28, 2004
  1.  ;IHS/OIT/LJF 07/20/2005 PATCH 1004 added subroutine to return 1 if patient active on a wait list
  1.  ;                                  added subroutine to return array of active waiting list entries for patient
  1.  ;                                  added display of user who added patient & user who removed patient
  1.  ;
  1. EN ;EP; -- main entry point for BSDRM WAIT LIST VIEW
  1.  ; variables already set coming into this routine:
  1.  ;   BSDN   = ien of patient multiple in Waiting List File
  1.  ;   BSDWLN = clinic ien in file
  1.  ;
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM WAIT LIST VIEW")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S VALMHDR(1)=$$SP(15)_$$CONF^BDGF
  1.  ;
  1.  S X=$G(IORVON)_$$GET1^DIQ(2,DFN,.01)_$G(IORVOFF)
  1.  S X=$$PAD(X,32)_"#"_$$HRCN^BDGF2(DFN,+$G(DUZ(2)))
  1.  S X=$$PAD(X,48)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
  1.  S VALMHDR(2)=$$PAD(X,68)_"Sex: "_$$GET1^DIQ(2,DFN,.02)
  1.  ;
  1.  I $$DEAD^BDGF2(DFN) S VALMHDR(3)=$$SP(25)_$G(IORVON)_"** Patient Died on "_$$DOD^BDGF2(DFN)_" **"_$G(IORVOFF)
  1.  E  S VALMHDR(3)=$$PCLINE^SDPPTEM(DFN,DT)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW LINE,BSDI,X
  1.  S VALMCNT=0 K ^TMP("BSDWLV",$J)
  1.  ;
  1.  S X=$$GET1^DIQ(9009017.1,BSDWLN,.01) D SET($$SP(23)_"CLINIC:"_$$SP(5)_X,.VALMCNT)    ;clinic name
  1.  ;
  1.  ; first section (date added, reason, recall date, provider, etc.)
  1.  F BSDI=.03,.09,.02,.06,.05 D
  1.  . S LINE=$J($P($G(^DD(9009017.11,BSDI,0)),U)_":",30)
  1.  . S LINE=$$PAD(LINE,35)_$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,BSDI)
  1.  . I BSDI=".03" S LINE=LINE_" by "_$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,.04)   ;IHS/OIT/LJF 7/22/2005 PATCH 1004
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; patient's home and office phones for recall
  1.  F BSDI=.131,.132 D
  1.  . S LINE=$J($P($G(^DD(2,BSDI,0)),U)_":",30)
  1.  . ;
  1.  . ;IHS/OIT/LJF 01/25/2007 PATCH 1007 fix code so phone #s print
  1.  . ;S LINE=$$PAD(LINE,35)_$$GET1^DIQ(2,BSDN_","_BSDWLN,BSDI)
  1.  . ;S LINE=$$PAD(LINE,35)_$$GET1^DIQ(2,BSDWLN_","_BSDN,BSDI)
  1.  . NEW DFN S DFN=$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,.01,"I")
  1.  . S LINE=$$PAD(LINE,35)_$$GET1^DIQ(2,+DFN,BSDI)
  1.  . S LINE=$$PAD(LINE,35)_$$GET1^DIQ(2,+DFN,BSDI)
  1.  . ;
  1.  . D SET(LINE,.VALMCNT)
  1.  ;
  1.  ; comments word-processing field
  1.  D SET("",.VALMCNT),SET("Comments:",.VALMCNT)
  1.  S BSDI=0 F  S BSDI=$O(^BSDWL(BSDWLN,1,BSDN,1,BSDI)) Q:'BSDI  D
  1.  . D SET($G(^BSDWL(BSDWLN,1,BSDN,1,BSDI,0)),.VALMCNT)
  1.  ;
  1.  ; last section (date removed and resolution)
  1.  D SET("",.VALMCNT)
  1.  F BSDI=.07,.08 D
  1.  . S LINE=$J($P($G(^DD(9009017.11,BSDI,0)),U)_":",30)
  1.  . S LINE=$$PAD(LINE,35)_$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,BSDI)
  1.  . I BSDI=".07" S LINE=LINE_" by "_$$GET1^DIQ(9009017.11,BSDN_","_BSDWLN,.11)   ;IHS/OIT/LJF 7/22/2005 PATCH 1004
  1.  . D SET(LINE,.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put data line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDWLV",$J,NUM,0)=DATA
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BSDWLV",$J) D KILL^AUPNPAT K BSDN
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  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)
  1.  ;
  1.  ;
  1. ONWL(PAT,TYPE) ; EP - returns 1 if patient active on at least one waiting list
  1.  ;IHS/OIT/LJF 7/20/2005 PATCH 1004 subroutine added
  1.  ;TYPE (optional) can be set to C for clinics only or W for wards only
  1.  I '$D(^BSDWL("AB",PAT)) Q 0
  1.  NEW WL,IEN,FOUND
  1.  S (WL,FOUND)=0 F  S WL=$O(^BSDWL("AB",PAT,WL)) Q:'WL  Q:FOUND  D
  1.  . I $G(TYPE)]"",$P($G(^SC(+^BSDWL(WL,0),0)),U,3)'=TYPE Q   ;skip if not correct type
  1.  . ;
  1.  . S IEN=0 F  S IEN=$O(^BSDWL("AB",PAT,WL,IEN)) Q:'IEN  Q:FOUND  D
  1.  . . I $P(^BSDWL(WL,1,IEN,0),U,7)]"" Q                        ;skip if already removed as active
  1.  . . S FOUND=1
  1.  Q FOUND
  1.  ;
  1. WLDATA(PAT,TYPE,BSDOUT) ; EP - return wait list info in BSDOUT array
  1.  ;IHS/OIT/LJF 7/20/2005 PATCH 1004 subroutine added
  1.  ; BSDOUT array is sorted by date added to the list
  1.  I '$O(^BSDWL(0)) S BSDOUT(0)="" Q
  1.  I '$$ONWL(PAT,$G(TYPE)) S BSDOUT(0)="Not currently on a Waiting List." Q
  1.  ;
  1.  NEW WL,IEN,FOUND,LINE,BSDATA,IENS,FILE,CNTA  ;cmi/maw 6/1/2010 PATCH 1012 adding counter for multiple wait list items
  1.  S CNTA=0  ;cmi/maw 6/1/2010 PATCH 1012 adding counter
  1.  ;
  1.  S (WL,FOUND)=0 F  S WL=$O(^BSDWL("AB",PAT,WL)) Q:'WL  D
  1.  . S IEN=0 F  S IEN=$O(^BSDWL("AB",PAT,WL,IEN)) Q:'IEN  D
  1.  . . I $P(^BSDWL(WL,1,IEN,0),U,7)]"" Q    ;skip if closed out
  1.  . . ;
  1.  . . S CNTA=CNTA+1  ;PATCH 1012
  1.  . . ; build display line
  1.  . . K BSDATA S IENS=IEN_","_WL_",",FILE=9009017.11
  1.  . . S ADDDT=$$GET1^DIQ(FILE,IENS,.03,"I")    ;date added for sorting
  1.  . . I ADDDT="" S BSDOUT(0)="Patient on Waiting List but critical data missing!" Q
  1.  . . D GETS^DIQ(FILE,IENS,".02;.03;.05;.06;1","R","BSDATA")
  1.  . . S LINE=BSDATA(FILE,IENS,"DATE ADDED TO LIST")_"/"
  1.  . . S LINE=$$PAD(LINE_BSDATA(FILE,IENS,"RECALL DATE"),27)
  1.  . . S LINE=$$PAD(LINE_$$GET1^DIQ(9009017.1,WL,.01),47)      ;clinic name
  1.  . . S LINE=$$PAD(LINE_$$SP(2)_BSDATA(FILE,IENS,"PROVIDER"),67)
  1.  . . S LINE=LINE_$$SP(3)_BSDATA(FILE,IENS,"PRIORITY")
  1.  . . ;S BSDOUT(ADDDT,1)=IENS_U_LINE  ;cmi/maw 6/1/2010 orig line
  1.  . . S BSDOUT(ADDDT,CNTA)=IENS_U_LINE  ;cmi/maw6/1/2010 PATCH 1012 RQMT149
  1.  . . ;
  1.  . . ; build comments array
  1.  . . S CNT=0 F  S CNT=$O(BSDATA(FILE,IENS,"COMMENTS",CNT)) Q:'CNT  D
  1.  . . . S BSDOUT(ADDDT,CNTA,CNT+1)=IENS_U_BSDATA(FILE,IENS,"COMMENTS",CNT)  ;cmi/maw 6/1/2010 PATCH 1012 RQMT149
  1.  ;
  1.  I $G(BSDOUT(0))]"" Q
  1.  ; if data found, add caption node in array
  1.  S BSDOUT(0)="  Date Added/Recall Date   Wait List Name        Provider            Priority"
  1.  Q