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

BDGEPI.m

Go to the documentation of this file. 
  1. BDGEPI ; IHS/ANMC/LJF - EXTENDED PATIENT INQUIRY ; 
  1.  ;;5.3;PIMS;**1007,1008,1010**;APR 26, 2002
  1.  ;
  1.  ;cmi/anch/maw 9/7/2007 mods in ASK PATCH 1007
  1.  ;cmi/flag/maw 8/31/2009 PATCH 1010 change reference of UB92 to UB04
  1.  ;
  1. ASK ;EP; when admission ien not known but patient is known
  1.  NEW DIC,X,Y,DGPMCA
  1.  ;S DIC=405,DIC(0)="EMQ",X=$$HRCN^BDGF2(DFN,DUZ(2))  ;cmi/anch/maw 9/7/2007 orig line PATCH 1007
  1.  ;S DIC=405,DIC(0)="EQ",D="C",X=$$HRCN^BDGF2(DFN,DUZ(2))  ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007
  1.  S DIC=405,DIC(0)="EQ",D="C",X=DFN  ;cmi/anch/maw 10/23/2007 i believe x should be DFN since we are looking up on that index only
  1.  S DIC("S")="I $P(^DGPM(+Y,0),U,2)=1",DIC("W")=""
  1.  ;D ^DIC Q:Y<1  ;cmi/anch/maw 9/7/2007 orig line
  1.  D IX^DIC Q:Y<1  K D  ;cmi/anch/maw 9/7/2007 per linda fels PATCH 1007
  1.  S DGPMCA=+Y D EN
  1.  Q
  1.  ;
  1. EN ;EP; -- main entry point for BDG EXTENDED PI
  1.  ; assumes DGPMCA is set to corresponding admission
  1.  ; and DFN is set to patient internal entry number
  1.  NEW VALMCNT
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG EXTENDED PI")
  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=$$NAMEPRT^BDGF2(DFN)_" (#"_$$HRCN^BDGF2(DFN,DUZ(2))_")"
  1.  S VALMHDR(2)=$$SP(75-$L(X)\2)_X
  1.  S X=$$STATUS^BDGF2(DFN),VALMHDR(3)=$$SP(75-$L(X)\2)_X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  NEW IEN,BDG,LINE,BDGX,IEN2,BDG2,DATE,X,FIRST
  1.  K ^TMP("BDGEPI",$J) S VALMCNT=0
  1.  ;
  1.  ; loop through all entries for this admission
  1.  S IEN=0 F  S IEN=$O(^DGPM("CA",DGPMCA,IEN)) Q:'IEN  D
  1.  . ;
  1.  . ; build array by date/time
  1.  . S DATE=+$G(^DGPM(IEN,0))
  1.  . I '$D(BDGX(DATE)) S BDGX(DATE,IEN)=""
  1.  . ; add service transfer to cooresponding physical movement
  1.  . I $D(BDGX(DATE)),'$D(BDGX(DATE,IEN)) S X=$O(BDGX(DATE,0)) I X S BDGX(DATE,X)=IEN
  1.  ;
  1.  ; loop by date to build display array
  1.  S DATE=0 F  S DATE=$O(BDGX(DATE)) Q:DATE=""  D
  1.  . S IEN=$O(BDGX(DATE,0)) Q:'IEN
  1.  . S IEN2=BDGX(DATE,IEN)
  1.  . ;
  1.  . ; gather data on this admission
  1.  . K BDG D ENP^XBDIQ1(405,IEN,".01:9999999.99","BDG(")
  1.  . K BDG2 D ENP^XBDIQ1(405,+IEN2,".01:9999999.99","BDG2(")
  1.  . S ARRAY=$S(IEN2:"BDG2",1:"BDG")
  1.  . ;
  1.  . ; build display line
  1.  . S LINE=$$PAD(BDG(.01),23)_$$MOVEMT(BDG(.02),BDG(.04))
  1.  . S LINE=$$PAD(LINE,50)_BDG(.06)_$$ROOM(BDG(.07))         ;room-bed
  1.  . S LINE=$$PAD(LINE,64)_$G(@ARRAY@(.09))                  ;service
  1.  . S LINE=$$PAD(LINE,85)_$E($G(@ARRAY@(9999999.02)),1,18)  ;admt prov
  1.  . S LINE=$$PAD(LINE,105)_$E($G(@ARRAY@(.19)),1,18)        ;atten prov
  1.  . D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . ; show transfer facility if appropriate
  1.  . I $G(BDG(.05))]"" D
  1.  .. S LINE=$$SP(25)_"("_$S(BDG(.02)="ADMISSION":"from ",1:"to ")
  1.  .. S LINE=LINE_BDG(.05)_")"
  1.  .. D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . ; display optional UB92 fields
  1.  . I (BDG(9999999.05)]"")!(BDG(9999999.06)]"") D
  1.  .. S LINE=$$SP(25)_"Admit type/source (UB04): "_BDG(9999999.05)  ;cmi/maw 08/31/2009 PATCH 1010 change reference to UB04
  1.  .. S LINE=LINE_"/"_BDG(9999999.06)
  1.  .. D SET(LINE,.VALMCNT)
  1.  . I BDG(9999999.07)]"" D SET($$SP(25)_"UB04 disposition: "_BDG(9999999.07),.VALMCNT)  ;cmi/maw 08/31/2009 PATCH 1010 change reference to UB04
  1.  . ;
  1.  . ; display short diagnosis and/or referral provider
  1.  . I BDG(.1)]"" D SET($$SP(25)_"Adm Dx: "_BDG(.1),.VALMCNT)
  1.  . I BDG(9999999.03)]"" D SET($$SP(25)_"Referred by "_BDG(9999999.03),.VALMCNT)
  1.  . ;
  1.  . ; display comment wp field
  1.  . I IEN2 S X=0,FIRST=1 F  S X=$O(^DGPM(IEN2,"DX",X)) Q:'X  D
  1.  .. S LINE=$S(FIRST:$$SP(25)_"Comments: ",1:$$SP(35)),FIRST=0
  1.  .. S LINE=LINE_^DGPM(IEN2,"DX",X,0)
  1.  .. D SET(LINE,.VALMCNT)
  1.  . ;
  1.  . D SET("",.VALMCNT)    ;blank line between events
  1.  ;
  1.  Q
  1.  ;
  1. MOVEMT(X1,X2) ; return type of movement phrase
  1.  I (X1="ADMISSION")!(X1="DISCHARGE") Q X1_"-"_X2
  1.  Q X2
  1.  ;
  1. ROOM(RBED) ; return room and bed-display mode
  1.  I RBED="" Q RBED
  1.  Q " ["_RBED_"]"
  1.  ;
  1. SET(LINE,NUMBER) ; put display line into array
  1.  S NUMBER=NUMBER+1
  1.  S ^TMP("BDGEPI",$J,NUMBER,0)=LINE
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGEPI",$J)
  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)