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

PXRMRDI.m

Go to the documentation of this file. 
  1. PXRMRDI ;SLC/PKR - Routines to support RDI list building. ;11/05/2013
  1.  ;;2.0;CLINICAL REMINDERS;**4,17,18,24,26**;Feb 04, 2005;Build 404
  1.  ;=========================================================
  1. APPERR(TYPE) ;Handle errors getting appointment data.
  1.  N ECODE,MGIEN,MGROUP,NL,TIME,TO,USER
  1.  S USER=$S($D(ZTQUEUED):DBDUZ,1:DUZ)
  1.  S TIME=$$NOW^XLFDT
  1.  S TIME=$$FMTE^XLFDT(TIME)
  1.  K ^TMP("PXRMXMZ",$J)
  1.  S ^TMP("PXRMXMZ",$J,1,0)="The "_TYPE_" requested by "_$$GET1^DIQ(200,USER,.01)_" on "
  1.  S ^TMP("PXRMXMZ",$J,2,0)=TIME_" requires appointment data which could not be obtained"
  1.  S ^TMP("PXRMXMZ",$J,3,0)="from the Scheduling database due to the following error(s):"
  1.  S ECODE=0,NL=3
  1.  F  S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE=""  D
  1.  . S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDAMA301",ECODE)
  1.  S TO(DUZ)=""
  1.  S MGIEN=$G(^PXRM(800,1,"MGFE"))
  1.  I MGIEN'="" D
  1.  . S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
  1.  . S TO(MGROUP)=""
  1.  D SEND^PXRMMSG("PXRMXMZ","Scheduling database error(s)",.TO,DUZ)
  1.  K ^TMP($J,"SDAMA301")
  1.  Q
  1.  ;
  1.  ;=========================================================
  1. APPL(NGET,BDT,EDT,PLIST,PARAM) ;List type computed finding that returns
  1.  ;a list of patients with appointments in the date range BDT to EDT.
  1.  N FILTER,FLDS,RESULT
  1.  K ^TMP($J,PLIST),^TMP($J,"SDAMA301")
  1.  I BDT<2000000 S BDT=2000101
  1.  S FILTER(1)=BDT_";"_EDT
  1.  S FILTER("SORT")="P"
  1.  ;Set the rest of the filter nodes.
  1.  D SFILTER(PARAM,.FILTER,.FLDS)
  1.  ;DBIA #4433
  1.  S RESULT=$$SDAPI^SDAMA301(.FILTER)
  1.  I RESULT=-1 D APPERR("Patient List build") Q
  1.  N COUNT,DATE,DFN,DONE,ITEM
  1.  S DFN=""
  1.  F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN=""  D
  1.  . S (COUNT,DONE)=0,DATE=""
  1.  . F  S DATE=$O(^TMP($J,"SDAMA301",DFN,DATE),-1) Q:(DONE)!(DATE="")  D
  1.  .. S COUNT=COUNT+1
  1.  .. S ITEM=$P(^TMP($J,"SDAMA301",DFN,DATE),U,2)
  1.  .. S ^TMP($J,PLIST,DFN,COUNT)=U_DATE_U_44_U_$P(ITEM,";",1)_U_$P(ITEM,";",2)
  1.  .. I COUNT=NGET S DONE=1
  1.  K ^TMP($J,"SDAMA301"),^TMP($J,"HLOCL")
  1.  Q
  1.  ;
  1.  ;=========================================================
  1. FSTATUS(STATUS) ;Format the STATUS, field #22.
  1.  N TEXT,TMP
  1.  S TMP=$P(STATUS,";",1)
  1.  S TEXT=$S(TMP="":"",1:"Code - "_TMP)
  1.  S TMP=$P(STATUS,";",2)
  1.  I TMP'="" S TEXT=TEXT_"; Description - "_TMP
  1.  S TMP=$P(STATUS,";",3)
  1.  I TMP'="" S TEXT=TEXT_"; Print Status - "_TMP
  1.  S TMP=$P(STATUS,";",4)
  1.  I TMP'="" S TEXT=TEXT_"; Checked In Date/Time - "_$$EDATE^PXRMDATE(TMP)
  1.  S TMP=$P(STATUS,";",5)
  1.  I TMP'="" S TEXT=TEXT_"; Checked Out Date/Time - "_$$EDATE^PXRMDATE(TMP)
  1.  S TMP=$P(STATUS,";",6)
  1.  I TMP'="" S TEXT=TEXT_"; Admission Movement IFN - "_TMP
  1.  Q TEXT
  1.  ;
  1.  ;=========================================================
  1. PAPPL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple type computed
  1.  ;finding that returns a list appointments for a patient.
  1.  N FIELD,FILTER,FLDS,PARAM,RESULT
  1.  K ^TMP($J,"SDAMA301")
  1.  S PARAM=TEST K TEST
  1.  S NFOUND=0
  1.  I BDT<2000000 S BDT=2000101
  1.  S FILTER(1)=BDT_";"_EDT
  1.  S FILTER(4)=DFN
  1.  S FILTER("SORT")="P"
  1.  ;Set the rest of the filter nodes.
  1.  D SFILTER(PARAM,.FILTER,.FLDS)
  1.  ;DBIA #4433
  1.  S RESULT=$$SDAPI^SDAMA301(.FILTER)
  1.  I RESULT=-1 D APPERR("Computed finding evaluation") Q
  1.  N ALLNULL,APPDATE,DATALIST,DONE,FLABEL,IND,ITEM,STATUS,TMP
  1.  S FLABEL(1)="APPOINTMENT DATE/TIME"
  1.  S FLABEL(2)="CLINIC"
  1.  S FLABEL(3)="APPOINTMENT STATUS"
  1.  S FLABEL(4)="PATIENT"
  1.  S FLABEL(5)="LENGTH OF APPOINTMENT"
  1.  S FLABEL(6)="COMMENTS"
  1.  S FLABEL(7)="OVERBOOK"
  1.  S FLABEL(8)="ELIGIBILITY OF VISIT"
  1.  S FLABEL(9)="CHECK-IN DATE/TIME"
  1.  S FLABEL(10)="APPOINTMENT TYPE"
  1.  S FLABEL(11)="CHECK-OUT DATE/TIME"
  1.  S FLABEL(12)="OUTPATIENT ENCOUNTER IEN"
  1.  S FLABEL(13)="PRIMARY STOP CODE"
  1.  S FLABEL(14)="CREDIT STOP CODE"
  1.  S FLABEL(15)="WORKLOAD NON-COUNT"
  1.  S FLABEL(16)="DATE APPOINTMENT MADE"
  1.  S FLABEL(17)="DESIRED DATE OF APPOINTMENT"
  1.  S FLABEL(18)="PURPOSE OF VISIT and SHORT DESCRIPTION"
  1.  S FLABEL(19)="EKG DATE/TIME"
  1.  S FLABEL(20)="X-RAY DATE/TIME"
  1.  S FLABEL(21)="LAB DATE/TIME"
  1.  S FLABEL(22)="STATUS"
  1.  S FLABEL(23)="X-RAY FILMS"
  1.  S FLABEL(24)="AUTO-REBOOKED APPOINTMENT DATE/TIME"
  1.  S FLABEL(25)="NO-SHOW/CANCEL DATE/TIME"
  1.  S FLABEL(26)="RSA APPOINTMENT ID"
  1.  S FLABEL(28)="DATA ENTRY CLERK"
  1.  S FLABEL(29)="NO-SHOW/CANCELED BY"
  1.  S FLABEL(30)="CHECK-IN USER"
  1.  S FLABEL(31)="CHECK-OUT USER"
  1.  S FLABEL(32)="CANCELLATION REASON"
  1.  S FLABEL(33)="CONSULT LINK"
  1.  S SDIR=$S(NGET<0:1,1:-1)
  1.  S NGET=$S(NGET<0:-NGET,1:NGET)
  1.  S APPDATE="",DONE=0
  1.  F  S APPDATE=$O(^TMP($J,"SDAMA301",DFN,APPDATE),SDIR) Q:(DONE)!(APPDATE="")  D
  1.  . S NFOUND=NFOUND+1
  1.  . S TEST(NFOUND)=1,DATE(NFOUND)=APPDATE
  1.  .;Fields 1-26
  1.  . S DATALIST=$G(^TMP($J,"SDAMA301",DFN,APPDATE))
  1.  .;Fields 28-33
  1.  . S TMP=$G(^TMP($J,"SDAMA301",DFN,APPDATE,0))
  1.  . S ALLNULL=1
  1.  . I TMP'="" F IND=1:1:$L(TMP,U) I $P(TMP,U,IND)'="" S ALLNULL=0
  1.  . I 'ALLNULL S $P(DATALIST,U,28)=TMP
  1.  . F IND=1:1:$L(DATALIST,U) D
  1.  .. S FIELD=$P(DATALIST,U,IND)
  1.  .. I IND=6 S FIELD=$G(^TMP($J,"SDAMA301",DFN,APPDATE,"C"))
  1.  .. I FIELD="" Q
  1.  .. I IND=22 S STATUS=FIELD
  1.  .. I FLABEL(IND)["DATE" S FIELD=$$EDATE^PXRMDATE(FIELD)
  1.  .. I FIELD[";" S FIELD=$P(FIELD,";",2)
  1.  ..;Save the clinic as the value.
  1.  .. I IND=2 S DATA(NFOUND,"VALUE")=FIELD
  1.  .. I IND=22 S FIELD=$$FSTATUS(STATUS)
  1.  .. S TEXT(NFOUND,IND)=FLABEL(IND)_": "_FIELD
  1.  .. S DATA(NFOUND,FLABEL(IND))=FIELD
  1.  . I NFOUND=NGET S DONE=1
  1.  K ^TMP($J,"SDAMA301"),^TMP($J,"HLOCL")
  1.  Q
  1.  ;
  1.  ;=========================================================
  1. SFILTER(PARAM,FILTER,FLDS) ;Parse the PARMETER and set the appropriate
  1.  ;fields.
  1.  N IND,LLNAME,LLP,P1,P2,STATUS,TEMP
  1.  S (FLDS,LLNAME,STATUS)=""
  1.  F IND=1:1:$L(PARAM,U) D
  1.  . S TEMP=$P(PARAM,U,IND)
  1.  . S P1=$P(TEMP,":",1),P2=$P(TEMP,":",2)
  1.  . I P1="FLDS" S FLDS=$TR(P2,",",";") Q
  1.  . I P1="LL" S LLNAME=P2 Q
  1.  . I P1="STATUS" S STATUS=$TR(P2,",",";") Q
  1.  S FILTER("FLDS")=$S(FLDS="":"1;2",1:FLDS)
  1.  S FILTER(3)=$S(STATUS="":"I;R",1:STATUS)
  1.  I LLNAME="" Q
  1.  S LLP=$O(^PXRMD(810.9,"B",LLNAME,""))
  1.  ;The LL VA-ALL LOCATIONS means no clinic filter.
  1.  I LLNAME'="VA-ALL LOCATIONS" D LOCLIST^PXRMLOCF(LLP,"HLOCL")
  1.  I $D(^TMP($J,"HLOCL")) S FILTER(2)="^TMP($J,""HLOCL"","
  1.  Q
  1.  ;
  1.  ;=========================================================
  1. TFL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,VALUE,TEXT) ;Multiple type computed
  1.  ;finding for a patient's treating facility list.
  1.  N DONE,IND,NOW,SDIR,TDATE,TFL,TFLD
  1.  S NFOUND=0
  1.  ;DBIA #2990
  1.  D TFL^VAFCTFU1(.TFL,DFN)
  1.  I +TFL(1)=-1 Q
  1.  S NOW=$$NOW^PXRMDATE
  1.  S (DONE,IND)=0
  1.  F  S IND=$O(TFL(IND)) Q:(DONE)!(IND="")  D
  1.  . S NFOUND=NFOUND+1
  1.  . S TEST(NFOUND)=1,DATE(NFOUND)=NOW
  1.  . S VALUE(NFOUND,"VALUE")=TFL(IND)
  1.  . I NFOUND=NGET S DONE=1 Q
  1.  F IND=1:1:NFOUND S VALUE(IND,"NUM FACILITIES")=NFOUND
  1.  Q
  1.  ;