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

BDGPI.m

Go to the documentation of this file. 
  1. BDGPI ; IHS/ANMC/LJF,WAR - PATIENT INQUIRY ;  [ 01/05/2005  10:24 AM ]
  1.  ;;5.3;PIMS;**1001,1003**;MAY 28, 2004
  1.  ;IHS/ITSC/LJF 5/27/2004 PATCH 1001 added Admission LOS to display
  1.  ;             5/13/2005 PATCH 1003 added parameter to day surgery expanded view
  1.  ;
  1.  NEW DFN
  1.  F  S DFN=+$$READ^BDGF("PO^2:EMQZ","Select PATIENT") Q:DFN<1  D EN
  1.  D EXIT
  1.  Q
  1.  ;
  1. EN ; -- main entry point for BDG PATIENT INQUIRY
  1.  NEW VALMCNT D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG PATIENT INQUIRY")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  S VALMHDR(1)=$$SP(10)_"*** "_$$CONF^BDGF_" ***"
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  D MSG^BDGF("Compiling patient's data...",1,0)
  1.  NEW X,BDGI,BDGS
  1.  S VALMCNT=0 K ^TMP("BDGPI",$J)
  1.  S BDGS=0 F BDGI=1:1:6 S X="SECTION"_BDGI,BDGS=BDGS+1 D @X
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGPI",$J) K SCDT2,SCP,DGPMCA,BDGSRN
  1.  D KILL^AUPNPAT,KVA^VADPT
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  NEW X,Y,Z,BDGN
  1.  D FULL^VALM1
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) Q
  1.  S X=0 F  S X=$O(VALMY(X)) Q:X=""  D
  1.  . S Y=0 F  S Y=$O(^TMP("BDGPI",$J,"IDX",Y)) Q:Y=""  D
  1.  .. S Z=$O(^TMP("BDGPI",$J,"IDX",Y,0))
  1.  .. Q:^TMP("BDGPI",$J,"IDX",Y,Z)=""
  1.  .. I Z=X S BDGN=^TMP("BDGPI",$J,"IDX",Y,Z)
  1.  ;
  1.  I '$G(BDGN) Q                           ;no selection
  1.  I BDGN=1 D ^BDGPI1 S VALMBCK="R" Q      ;demographics
  1.  ;
  1.  I (BDGN'=1),(BDGN'=5),$D(^XUSEC("DGZNOCLN",DUZ)) D  Q
  1.  . D MSG^BDGF("Sorry, you do not have access to clinical data.",1,0)
  1.  . D PAUSE^BDGF S VALMBCK="R"
  1.  ;
  1.  I BDGN=2 D ASK^BDGEPI S VALMBCK="R" Q         ;last admission details
  1.  ;
  1.  ;IHS/ITSC/LJF 5/13/2005 PATCH 1003 added DFN to parameter list; BDGPI3 assumes it is set
  1.  ;I BDGN=3 D EN^BDGPI3($G(BDGSRN),$G(BDGDSN)) S VALMBCK="R" Q   ;day surg
  1.  I BDGN=3 D EN^BDGPI3($G(BDGSRN),$G(BDGDSN),$G(DFN)) S VALMBCK="R" Q   ;day surg
  1.  ;end of PATCH 1003 changes
  1.  ;
  1.  I BDGN=4 K BDGSVE D PATSET^BDGSVE S VALMBCK="R" Q    ;sched visits
  1.  I BDGN=5 D  S VALMBCK="R" Q                          ;future appts
  1.  . S BSDBD=DT,BSDED=$$FMADD^XLFDT(DT,365)             ;date range
  1.  . S BSDDFN=DFN D EN^BSDDPA S DFN=BSDDFN K BSDDFN
  1.  I BDGN=6 D PATSET^BDGICF2 S VALMBCK="R"              ;incomplete chart
  1.  Q
  1.  ;
  1. SECTION1 ; -- set up demographic data for display
  1.  NEW LINE,BDGR
  1.  D SET("("_BDGS_") Demographics -",.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; sensitive patient warning first
  1.  K BDGR D SENS^DGSEC4(.BDGR,DFN,DUZ) I BDGR(1)>0 D
  1.  . D SET($$SP(15)_$G(IORVON)_"*** WARNING!!!  RESTRICTED PATIENT RECORD ***"_$G(IORVOFF),.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  I $$OPTOUT^BDGF1(DFN) D
  1.  . D SET($$SP(10)_$G(IORVON)_"DO NOT DISCLOSE INFORMATION ABOUT PATIENT"_$G(IORVOFF),.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; name, cwad display, chart # and date of birth
  1.  S LINE=$$GET1^DIQ(2,DFN,.01)_" "_$TR($$CWAD^BDGF2(DFN)," ","")
  1.  S LINE=$$PAD(LINE,32)_"HRCN: "_$$HRCN^BDGF2(DFN,DUZ(2))
  1.  S LINE=$$PAD(LINE,54)_"DOB: "_$$GET1^DIQ(2,DFN,.03)
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; street address, home phone and primary care provider
  1.  S LINE=$$PAD($$GET1^DIQ(2,DFN,.111),31)
  1.  S LINE=LINE_"PHONE: "_$$GET1^DIQ(2,DFN,.131)
  1.  S LINE=$$PAD(LINE,54)_"SEX: "_$$GET1^DIQ(2,DFN,.02)
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; city, state, eligibility, primary care provider
  1.  S LINE=$$GET1^DIQ(2,DFN,.114)_", "_$$STATE(DFN)_" "_$$GET1^DIQ(2,DFN,.116)
  1.  S LINE=$$PAD(LINE,32)_"ELIG: "_$E($$GET1^DIQ(9000001,DFN,1112),1,15)
  1.  S X=$$GET1^DIQ(2,DFN,.09),X=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,9)
  1.  S LINE=$$PAD(LINE,54)_"SSN: "_X
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; service unit based on community of residence
  1.  S LINE=$$GET1^DIQ(9999999.05,+$$GET1^DIQ(9000001,DFN,1117,"I"),.05)
  1.  I LINE]"" D SET("("_LINE_" Service Unit)",.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; primary care provider and team
  1.  K BDGR S BDGR="BDGR" D PCP^BSDU1(DFN,.BDGR)
  1.  S LINE="PCP/TEAM: "_$P($G(BDGR(1)),"/")_" / "_$P($G(BDGR(1)),"/",2)
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  Q
  1.  ;
  1. SECTION2 ; -- set up last admission for display
  1.  ; skip if not inpt facility
  1.  I $$OUTPT^BDGPAR(DUZ(2)) S BDGS=BDGS-1 Q
  1.  ;
  1.  ; current patient status
  1.  NEW LINE,VAIP
  1.  S LINE="("_BDGS_") Current Inpatient Status - "_$$STATUS^BDGF2(DFN)
  1.  D SET("",.VALMCNT,BDGS,BDGI),SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; last admission display
  1.  S VAIP("D")="L" D INP^DGPMV10
  1.  S DGPMCA=$G(DGPMVI(13))  ;needed by expand entry-killed in EXIT
  1.  ;
  1.  I '$D(^DGPM("C",DFN)) D  Q
  1.  . S LINE="PATIENT HAS NO INPATIENT OR LODGER ACTIVITY IN THE COMPUTER"
  1.  . D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  S LINE=$S("^4^5^"'[(U_+DGPMVI(2)_U):"Admitted",1:"Checked-in")
  1.  S LINE=$$PAD(LINE,12)_": "_$P(DGPMVI(13,1),U,2)
  1.  S LINE=$$PAD(LINE,39)_$S("^4^5^"[(U_+DGPMVI(2)_U):"Checked-out",+DGPMVI(2)=3:"Discharged ",1:"Transferred")
  1.  S LINE=$$PAD(LINE,54)_": "_$S("^1^4^"'[(U_+DGPMVI(2)_U):$P(DGPMVI(3),U,2),$P(DGPMVI(3),U,2)'=$P(DGPMVI(13,1),U,2):$P(DGPMVI(3),U,2),1:"")
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  S LINE=$$PAD("Ward",12)_": "_$E($P(DGPMVI(5),U,2),1,24)
  1.  S LINE=$$PAD(LINE,39)_"Room-Bed/Ext   : "_$E($P(DGPMVI(6),U,2),1,21)
  1.  S LINE=LINE_" / "_$$GET1^DIQ(405.4,+DGPMVI(6),9999999.01)
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  I "^4^5^"'[(U_+DGPMVI(2)_U) D
  1.  . S LINE=$$PAD("Admitted by",12)_": "_$E(DGPMVI(9999999.02),1,21)
  1.  . S LINE=$$PAD(LINE,39)_"Specialty      : "_$E($P(DGPMVI(8),U,2),1,21)
  1.  . D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  S LINE=$$PAD("Attending",12)_": "_$E($P(DGPMVI(18),U,2),1,26)
  1.  NEW DGPMIFN S DGPMIFN=DGPMCA D ^DGPMLOS S LINE=$$PAD(LINE,39)_"Admission LOS  : "_$P(X,U,5)   ;IHS/ITSC/LJF 5/27/2004; PATCH #1001
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  K DGPMT,DGPMIFN,DGPMVI,DGPMDCD
  1.  Q
  1.  ;
  1. SECTION3 ; -- set up last day surgery for display
  1.  ; skip if not running day surgery program
  1.  I ('$O(^SRF(0))),('$O(^ADGDS(0))) S BDGS=BDGS-1 Q
  1.  ;
  1.  K BDGSRN,BDGDSN   ;ien in surgery files-saved for expand entry action
  1.  ;
  1.  ; if VA Surgery is running at site, find last day surgery on file
  1.  NEW X,BDGX,BDGLDS,I
  1.  S X="BSRPEP" X ^%ZOSF("TEST")
  1.  I $T S BDGX="BDGX",BDGLDS=$$LASTDS^BSRPEP(DFN,.BDGX)
  1.  I $G(BDGLDS) D  Q
  1.  . D SET("",.VALMCNT,BDGS,BDGI)
  1.  . D SET("("_BDGS_") "_"Last Day Surgery -",.VALMCNT,BDGS,BDGI)
  1.  . F I=1:1 Q:'$D(BDGX(I))  D SET(BDGX(I),.VALMCNT,BDGS,BDGI)
  1.  . S BDGSRN=BDGX(0)     ;ien in surgery file-used by expand entry
  1.  ;
  1.  ; else find last day surgery in ADT file
  1.  I '$D(^ADGDS(DFN)) D  Q
  1.  . D SET("",.VALMCNT,BDGS,BDGI)
  1.  . D SET("("_BDGS_")  No Day Surgeries on file",.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  NEW X,IEN,IENS,LINE
  1.  S X=$O(^ADGDS("APID",DFN,0)) Q:'X             ;inverse surgery date
  1.  S IEN=$O(^ADGDS("APID",DFN,X,0)) Q:'IEN       ;subfile ien
  1.  Q:'$D(^ADGDS(DFN,"DS",IEN,0))                 ;quit if bad xref
  1.  S BDGDSN=IEN    ;ien in day surgery file-used in expand entry
  1.  D SET("",.VALMCNT,BDGS,BDGI)
  1.  D SET("("_BDGS_") "_"Last Day Surgery -",.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  ; surgery date, time released, length of stay
  1.  S IENS=IEN_","_DFN
  1.  S LINE="Surgery Date/Time: "_$$GET1^DIQ(9009012.01,IENS,.01)
  1.  S X=$$GET1^DIQ(9009012.01,IENS,7)             ;release date/time
  1.  I X]"" D
  1.  . S LINE=$$PAD(LINE,38)_"Released: "_X
  1.  . S LINE=LINE_"  LOS: "_$$GET1^DIQ(9009012.01,IENS,8)_" hrs"
  1.  . D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  E  D
  1.  . I $$GET1^DIQ(9009012.01,IENS,12)="YES" D  Q
  1.  .. S LINE=$$PAD(LINE,38)_"**CANCELLED**" D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  . I $$GET1^DIQ(9009012.01,IENS,13)="YES" D  Q
  1.  .. S LINE=$$PAD(LINE,38)_"**NO-SHOW**" D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  .I $L(LINE)'>38 D
  1.  ..S LINE=$$PAD(LINE,38)_"Released: Not entered yet   LOS: n/a"
  1.  ..D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  S LINE=$$SP(9)_"Service: "_$$GET1^DIQ(9009012.01,IENS,4)
  1.  S LINE=$$PAD(LINE,38)_"Surgeon: "_$$GET1^DIQ(9009012.01,IENS,5)
  1.  D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  ;
  1.  Q
  1.  ;
  1. SECTION4 ; -- set up scheduled visits for display
  1.  D SECTION4^BDGPI0
  1.  Q
  1.  ;
  1. SECTION5 ; -- set up list of future appts for display
  1.  NEW LINE,X
  1.  K ^TMP("BDGPI1",$J)
  1.  D GUIR^XBLM("FA^DGRPD","^TMP(""BDGPI1"",$J,")
  1.  NEW X S X=0 F  S X=$O(^TMP("BDGPI1",$J,X)) Q:'X  D
  1.  . S LINE=$S(X=3:"("_BDGS_") ",1:$$SP(4))_$G(^TMP("BDGPI1",$J,X))
  1.  . D SET(LINE,.VALMCNT,BDGS,BDGI)
  1.  K ^TMP("BDGPI1",$J)
  1.  Q
  1.  ;
  1. SECTION6 ; -- set up chart's status for display
  1.  D SECTION6^BDGPI0
  1.  Q
  1.  ;
  1. SET(LINE,LNUM,SNUM,SECTION) ; -- set display line into array
  1.  ; LINE= display line
  1.  ; LNUM=line number (VALMCNT)
  1.  ; SNUM=section # (BDGS)
  1.  ; SECTION=actual section (from INIT for loop - BDGI)
  1.  S LNUM=LNUM+1
  1.  S ^TMP("BDGPI",$J,LNUM,0)=LINE
  1.  S ^TMP("BDGPI",$J,"IDX",LNUM,SNUM)=SECTION
  1.  Q
  1.  ;
  1. STATE(P) ; -- returns 2 letter state abbreviation for patient's address
  1.  NEW X
  1.  S X=$$GET1^DIQ(2,P,.115,"I") I 'X Q ""
  1.  Q $$GET1^DIQ(5,X,1)
  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)