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

BSDCF.m

Go to the documentation of this file. 
  1. BSDCF ; IHS/ANMC/LJF - CHART FINDER ;  [ 06/19/2002  11:29 AM ]
  1.  ;;5.3;PIMS;**1005,1007**;MAY 28, 2004
  1.  ;IHS/OIT/LJF 01/19/2006 PATCH 1005 added ability to call with patient defined
  1.  ;cmi/anch/maw added line in ACTIONS for delivery date on chart finder patch 1007 item 1007.20
  1.  ;cmi/anch/maw added line in ACTIONS for listing of provider if there patch 1007 item 1007.21
  1.  ;
  1. ASK ; ask user questions
  1.  ;NEW DFN,BSDBD
  1.  NEW DFN     ;IHS/OIT/LJF 01/19/2006 PATCH 1005 moved BSDBD to PAT+1
  1.  S DFN=+$$READ^BDGF("PO^2:EMQ","Select Patient") Q:DFN<1
  1.  ;
  1. PAT ;EP; called if DFN already set (such as Other Reports under AM);IHS/OIT/LJF 01/19/2006 PATCH 1005
  1.  NEW BSDBD   ;IHS/OIT/LJF 01/19/2006 PATCH 1005 moved new from ASK+1
  1.  S BSDBD=$$READ^BDGF("DO^::EX","Select Beginning Date for Search")
  1.  Q:BSDBD<1
  1.  ;
  1. EN ; -- main entry point for BSDRM CHART FINDER
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BSDRM CHART FINDER")
  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=$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.  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.  S VALMHDR(4)=$$SP(15)_"Includes actions for "_$$RANGE^BDGF(BSDBD,DT)
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  S VALMCNT=0 K ^TMP("BSDCF",$J),^TMP("BSDCF1",$J)
  1.  ;
  1.  ; display patient's current status
  1.  D SET("Current Status: "_$$STATUS^BDGF2(DFN),.VALMCNT),SET("",.VALMCNT)
  1.  ;
  1.  ; build list of actions by date and type
  1.  D ACTIONS(DFN)
  1.  ;
  1.  ; put actions in display array by date
  1.  NEW DATE,TYP
  1.  S DATE=0 F  S DATE=$O(^TMP("BSDCF1",$J,DATE))  Q:'DATE  D
  1.  . S TYP=0 F  S TYP=$O(^TMP("BSDCF1",$J,DATE,TYP)) Q:TYP=""  D
  1.  .. D SET(^TMP("BSDCF1",$J,DATE,TYP),.VALMCNT)
  1.  K ^TMP("BSDCF1",$J)
  1.  Q
  1.  ;
  1. ACTIONS(DFN) ; build list of chart actions for date range
  1.  ;
  1.  ; find all appts within date range
  1.  NEW D,NODE,STATUS,LINE,TYPE
  1.  S D=BSDBD-.0001 F  S D=$O(^DPT(DFN,"S",D)) Q:'D  Q:D>(DT+.2400)  D
  1.  . S NODE=$G(^DPT(DFN,"S",D,0)),TYPE=$$APPTYP^BSDU2(DFN,D)
  1.  . S STATUS=$$STATUS^SDAM1(DFN,D,+NODE,NODE,$$SCIEN^BSDU2(DFN,+NODE,D))
  1.  . S LINE=$$PAD($$FMTE^XLFDT(D),20)_$E($$GET1^DIQ(44,+NODE,.01),1,15)
  1.  . S LINE=$$PAD(LINE,38)_TYPE_" Appt"
  1.  . S LINE=$$PAD(LINE,53)_"("_$P(STATUS,";",3)_")"
  1.  . S ^TMP("BSDCF1",$J,D,TYPE)=LINE
  1.  ;
  1.  ; find all chart requests within date range
  1.  NEW C,D,N,LINE
  1.  NEW D1
  1.  S C=0 F  S C=$O(^SC("AIHSCR",DFN,C)) Q:'C  D
  1.  . S D=BSDBD-.0001
  1.  . F  S D=$O(^SC("AIHSCR",DFN,C,D)) Q:'D  Q:D>(DT+.24)  D
  1.  .. S N=0 F  S N=$O(^SC("AIHSCR",DFN,C,D,N)) Q:'N  D
  1.  ... S D1=$E(+$G(^SC(C,"C",D,1,N,9999999)),1,12)   ;date/time requested
  1.  ... S LINE=$$PAD($$FMTE^XLFDT(D1),20)_$E($$GET1^DIQ(44,C,.01),1,15)
  1.  ... S LINE=$$PAD(LINE,38)_"Chart Request"
  1.  ... S LINE=$$PAD(LINE,53)_"("_$P($G(^SC(C,"C",D,1,N,9999999)),U,3)_")"
  1.  ... S LINE=$$PAD(LINE,100)_"Requested by "_$$GET1^DIQ(200,+$P($G(^SC(C,"C",D,1,N,9999999)),U,2),.01)
  1.  ... S ^TMP("BSDCF1",$J,D1,"CR")=LINE
  1.  ... S LINE=$$PAD("     Date Delivered "_$S($G(^SC(C,"C",D,0)):"("_$$FMTE^XLFDT($G(^SC(C,"C",D,0)))_")",1:""),40)  ;cmi/anch/maw 1/21/2007 added for delivery date patch 1007 item 1007.20
  1.  ... S ^TMP("BSDCF1",$J,D1,"CR1")=LINE  ;cmi/anch/maw 1/21/2007 added for date delivered patch 1007 item 1007.20
  1.  ;
  1.  ; find any active incomplete chart entries
  1.  NEW IEN,X,TYPE,DATE
  1.  S IEN=0 F  S IEN=$O(^BDGIC("B",DFN,IEN)) Q:'IEN  D
  1.  . S X=$$GET1^DIQ(9009020.1,$$DIV^BSDU,.13)        ;bill prep tracked?
  1.  . I X="NO",$$GET1^DIQ(9009016.1,IEN,.14)]""  Q    ;chart completed
  1.  . Q:$$GET1^DIQ(9009016.1,IEN,.15)]""              ;bill prep done
  1.  . ;
  1.  . S TYPE=$$GET1^DIQ(9009016.1,IEN,.0392)          ;visit type
  1.  . S X=$$GET1^DIQ(9009016.1,IEN,$S(TYPE["DAY":.05,1:.02))         ;date
  1.  . S DATE=$$GET1^DIQ(9009016.1,IEN,$S(TYPE["DAY":.05,1:.02),"I")  ;date
  1.  . I DATE="" S DATE="??"
  1.  . ;cmi/anch/maw 2/21/2007 added the following code for incomplete charts PATCH 1007 item 1007.21
  1.  . I '$D(^BDGIC(IEN,1)) D  Q
  1.  .. S LINE=$$PAD($$PAD(X,20)_TYPE_" Incomplete Chart",55)
  1.  .. S LINE=LINE_$$GET1^DIQ(9009016.1,IEN,$S(TYPE["DAY":.06,1:.04))  ;srv
  1.  .. S ^TMP("BSDCF1",$J,DATE,"IC")=LINE
  1.  . N BSDPRV
  1.  . S BSDPRV=0 F  S BSDPRV=$O(^BDGIC(IEN,1,BSDPRV)) Q:'BSDPRV  D
  1.  .. N IENS,BSDDSP,BSDPRVE
  1.  .. S IENS=BSDPRV_","_IEN
  1.  .. S BSDDSP=$$GET1^DIQ(9009016.11,IENS,.0393)
  1.  .. Q:BSDDSP'="Pending"
  1.  .. S BSDPRVE=$$GET1^DIQ(9009016.11,IENS,.01)
  1.  .. S LINE=$$PAD($$PAD(X,20)_TYPE_" Incomplete Chart",55)
  1.  .. S LINE=LINE_$$GET1^DIQ(9009016.1,IEN,$S(TYPE["DAY":.06,1:.04))  ;srv
  1.  .. S LINE=LINE_$$PAD(BSDPRVE,20)
  1.  .. ;S ^TMP("BSDCF1",$J,DATE,"IC")=LINE
  1.  .. S ^TMP("BSDCF1",$J,BSDPRV,"IC")=LINE
  1.  ;cmi/anch/maw 2/21/2007 end of mods PATCH 1007 item 1007.21
  1.  ;
  1.  Q
  1.  ;
  1. SET(DATA,NUM) ; put data line into display array
  1.  S NUM=NUM+1
  1.  S ^TMP("BSDCF",$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.  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)