PXRMRDI ;SLC/PKR - Routines to support RDI list building. ;11/05/2013
;;2.0;CLINICAL REMINDERS;**4,17,18,24,26**;Feb 04, 2005;Build 404
;=========================================================
APPERR(TYPE) ;Handle errors getting appointment data.
N ECODE,MGIEN,MGROUP,NL,TIME,TO,USER
S USER=$S($D(ZTQUEUED):DBDUZ,1:DUZ)
S TIME=$$NOW^XLFDT
S TIME=$$FMTE^XLFDT(TIME)
K ^TMP("PXRMXMZ",$J)
S ^TMP("PXRMXMZ",$J,1,0)="The "_TYPE_" requested by "_$$GET1^DIQ(200,USER,.01)_" on "
S ^TMP("PXRMXMZ",$J,2,0)=TIME_" requires appointment data which could not be obtained"
S ^TMP("PXRMXMZ",$J,3,0)="from the Scheduling database due to the following error(s):"
S ECODE=0,NL=3
F S ECODE=$O(^TMP($J,"SDAMA301",ECODE)) Q:ECODE="" D
. S NL=NL+1,^TMP("PXRMXMZ",$J,NL,0)=" "_^TMP($J,"SDAMA301",ECODE)
S TO(DUZ)=""
S MGIEN=$G(^PXRM(800,1,"MGFE"))
I MGIEN'="" D
. S MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
. S TO(MGROUP)=""
D SEND^PXRMMSG("PXRMXMZ","Scheduling database error(s)",.TO,DUZ)
K ^TMP($J,"SDAMA301")
Q
;
;=========================================================
APPL(NGET,BDT,EDT,PLIST,PARAM) ;List type computed finding that returns
;a list of patients with appointments in the date range BDT to EDT.
N FILTER,FLDS,RESULT
K ^TMP($J,PLIST),^TMP($J,"SDAMA301")
I BDT<2000000 S BDT=2000101
S FILTER(1)=BDT_";"_EDT
S FILTER("SORT")="P"
;Set the rest of the filter nodes.
D SFILTER(PARAM,.FILTER,.FLDS)
;DBIA #4433
S RESULT=$$SDAPI^SDAMA301(.FILTER)
I RESULT=-1 D APPERR("Patient List build") Q
N COUNT,DATE,DFN,DONE,ITEM
S DFN=""
F S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:DFN="" D
. S (COUNT,DONE)=0,DATE=""
. F S DATE=$O(^TMP($J,"SDAMA301",DFN,DATE),-1) Q:(DONE)!(DATE="") D
.. S COUNT=COUNT+1
.. S ITEM=$P(^TMP($J,"SDAMA301",DFN,DATE),U,2)
.. S ^TMP($J,PLIST,DFN,COUNT)=U_DATE_U_44_U_$P(ITEM,";",1)_U_$P(ITEM,";",2)
.. I COUNT=NGET S DONE=1
K ^TMP($J,"SDAMA301"),^TMP($J,"HLOCL")
Q
;
;=========================================================
FSTATUS(STATUS) ;Format the STATUS, field #22.
N TEXT,TMP
S TMP=$P(STATUS,";",1)
S TEXT=$S(TMP="":"",1:"Code - "_TMP)
S TMP=$P(STATUS,";",2)
I TMP'="" S TEXT=TEXT_"; Description - "_TMP
S TMP=$P(STATUS,";",3)
I TMP'="" S TEXT=TEXT_"; Print Status - "_TMP
S TMP=$P(STATUS,";",4)
I TMP'="" S TEXT=TEXT_"; Checked In Date/Time - "_$$EDATE^PXRMDATE(TMP)
S TMP=$P(STATUS,";",5)
I TMP'="" S TEXT=TEXT_"; Checked Out Date/Time - "_$$EDATE^PXRMDATE(TMP)
S TMP=$P(STATUS,";",6)
I TMP'="" S TEXT=TEXT_"; Admission Movement IFN - "_TMP
Q TEXT
;
;=========================================================
PAPPL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple type computed
;finding that returns a list appointments for a patient.
N FIELD,FILTER,FLDS,PARAM,RESULT
K ^TMP($J,"SDAMA301")
S PARAM=TEST K TEST
S NFOUND=0
I BDT<2000000 S BDT=2000101
S FILTER(1)=BDT_";"_EDT
S FILTER(4)=DFN
S FILTER("SORT")="P"
;Set the rest of the filter nodes.
D SFILTER(PARAM,.FILTER,.FLDS)
;DBIA #4433
S RESULT=$$SDAPI^SDAMA301(.FILTER)
I RESULT=-1 D APPERR("Computed finding evaluation") Q
N ALLNULL,APPDATE,DATALIST,DONE,FLABEL,IND,ITEM,STATUS,TMP
S FLABEL(1)="APPOINTMENT DATE/TIME"
S FLABEL(2)="CLINIC"
S FLABEL(3)="APPOINTMENT STATUS"
S FLABEL(4)="PATIENT"
S FLABEL(5)="LENGTH OF APPOINTMENT"
S FLABEL(6)="COMMENTS"
S FLABEL(7)="OVERBOOK"
S FLABEL(8)="ELIGIBILITY OF VISIT"
S FLABEL(9)="CHECK-IN DATE/TIME"
S FLABEL(10)="APPOINTMENT TYPE"
S FLABEL(11)="CHECK-OUT DATE/TIME"
S FLABEL(12)="OUTPATIENT ENCOUNTER IEN"
S FLABEL(13)="PRIMARY STOP CODE"
S FLABEL(14)="CREDIT STOP CODE"
S FLABEL(15)="WORKLOAD NON-COUNT"
S FLABEL(16)="DATE APPOINTMENT MADE"
S FLABEL(17)="DESIRED DATE OF APPOINTMENT"
S FLABEL(18)="PURPOSE OF VISIT and SHORT DESCRIPTION"
S FLABEL(19)="EKG DATE/TIME"
S FLABEL(20)="X-RAY DATE/TIME"
S FLABEL(21)="LAB DATE/TIME"
S FLABEL(22)="STATUS"
S FLABEL(23)="X-RAY FILMS"
S FLABEL(24)="AUTO-REBOOKED APPOINTMENT DATE/TIME"
S FLABEL(25)="NO-SHOW/CANCEL DATE/TIME"
S FLABEL(26)="RSA APPOINTMENT ID"
S FLABEL(28)="DATA ENTRY CLERK"
S FLABEL(29)="NO-SHOW/CANCELED BY"
S FLABEL(30)="CHECK-IN USER"
S FLABEL(31)="CHECK-OUT USER"
S FLABEL(32)="CANCELLATION REASON"
S FLABEL(33)="CONSULT LINK"
S SDIR=$S(NGET<0:1,1:-1)
S NGET=$S(NGET<0:-NGET,1:NGET)
S APPDATE="",DONE=0
F S APPDATE=$O(^TMP($J,"SDAMA301",DFN,APPDATE),SDIR) Q:(DONE)!(APPDATE="") D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=1,DATE(NFOUND)=APPDATE
.;Fields 1-26
. S DATALIST=$G(^TMP($J,"SDAMA301",DFN,APPDATE))
.;Fields 28-33
. S TMP=$G(^TMP($J,"SDAMA301",DFN,APPDATE,0))
. S ALLNULL=1
. I TMP'="" F IND=1:1:$L(TMP,U) I $P(TMP,U,IND)'="" S ALLNULL=0
. I 'ALLNULL S $P(DATALIST,U,28)=TMP
. F IND=1:1:$L(DATALIST,U) D
.. S FIELD=$P(DATALIST,U,IND)
.. I IND=6 S FIELD=$G(^TMP($J,"SDAMA301",DFN,APPDATE,"C"))
.. I FIELD="" Q
.. I IND=22 S STATUS=FIELD
.. I FLABEL(IND)["DATE" S FIELD=$$EDATE^PXRMDATE(FIELD)
.. I FIELD[";" S FIELD=$P(FIELD,";",2)
..;Save the clinic as the value.
.. I IND=2 S DATA(NFOUND,"VALUE")=FIELD
.. I IND=22 S FIELD=$$FSTATUS(STATUS)
.. S TEXT(NFOUND,IND)=FLABEL(IND)_": "_FIELD
.. S DATA(NFOUND,FLABEL(IND))=FIELD
. I NFOUND=NGET S DONE=1
K ^TMP($J,"SDAMA301"),^TMP($J,"HLOCL")
Q
;
;=========================================================
SFILTER(PARAM,FILTER,FLDS) ;Parse the PARMETER and set the appropriate
;fields.
N IND,LLNAME,LLP,P1,P2,STATUS,TEMP
S (FLDS,LLNAME,STATUS)=""
F IND=1:1:$L(PARAM,U) D
. S TEMP=$P(PARAM,U,IND)
. S P1=$P(TEMP,":",1),P2=$P(TEMP,":",2)
. I P1="FLDS" S FLDS=$TR(P2,",",";") Q
. I P1="LL" S LLNAME=P2 Q
. I P1="STATUS" S STATUS=$TR(P2,",",";") Q
S FILTER("FLDS")=$S(FLDS="":"1;2",1:FLDS)
S FILTER(3)=$S(STATUS="":"I;R",1:STATUS)
I LLNAME="" Q
S LLP=$O(^PXRMD(810.9,"B",LLNAME,""))
;The LL VA-ALL LOCATIONS means no clinic filter.
I LLNAME'="VA-ALL LOCATIONS" D LOCLIST^PXRMLOCF(LLP,"HLOCL")
I $D(^TMP($J,"HLOCL")) S FILTER(2)="^TMP($J,""HLOCL"","
Q
;
;=========================================================
TFL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,VALUE,TEXT) ;Multiple type computed
;finding for a patient's treating facility list.
N DONE,IND,NOW,SDIR,TDATE,TFL,TFLD
S NFOUND=0
;DBIA #2990
D TFL^VAFCTFU1(.TFL,DFN)
I +TFL(1)=-1 Q
S NOW=$$NOW^PXRMDATE
S (DONE,IND)=0
F S IND=$O(TFL(IND)) Q:(DONE)!(IND="") D
. S NFOUND=NFOUND+1
. S TEST(NFOUND)=1,DATE(NFOUND)=NOW
. S VALUE(NFOUND,"VALUE")=TFL(IND)
. I NFOUND=NGET S DONE=1 Q
F IND=1:1:NFOUND S VALUE(IND,"NUM FACILITIES")=NFOUND
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMRDI 6677 printed Dec 13, 2024@01:48:47 Page 2
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
+2 ;=========================================================
APPERR(TYPE) ;Handle errors getting appointment data.
+1 NEW ECODE,MGIEN,MGROUP,NL,TIME,TO,USER
+2 SET USER=$SELECT($DATA(ZTQUEUED):DBDUZ,1:DUZ)
+3 SET TIME=$$NOW^XLFDT
+4 SET TIME=$$FMTE^XLFDT(TIME)
+5 KILL ^TMP("PXRMXMZ",$JOB)
+6 SET ^TMP("PXRMXMZ",$JOB,1,0)="The "_TYPE_" requested by "_$$GET1^DIQ(200,USER,.01)_" on "
+7 SET ^TMP("PXRMXMZ",$JOB,2,0)=TIME_" requires appointment data which could not be obtained"
+8 SET ^TMP("PXRMXMZ",$JOB,3,0)="from the Scheduling database due to the following error(s):"
+9 SET ECODE=0
SET NL=3
+10 FOR
SET ECODE=$ORDER(^TMP($JOB,"SDAMA301",ECODE))
if ECODE=""
QUIT
Begin DoDot:1
+11 SET NL=NL+1
SET ^TMP("PXRMXMZ",$JOB,NL,0)=" "_^TMP($JOB,"SDAMA301",ECODE)
End DoDot:1
+12 SET TO(DUZ)=""
+13 SET MGIEN=$GET(^PXRM(800,1,"MGFE"))
+14 IF MGIEN'=""
Begin DoDot:1
+15 SET MGROUP="G."_$$GET1^DIQ(3.8,MGIEN,.01)
+16 SET TO(MGROUP)=""
End DoDot:1
+17 DO SEND^PXRMMSG("PXRMXMZ","Scheduling database error(s)",.TO,DUZ)
+18 KILL ^TMP($JOB,"SDAMA301")
+19 QUIT
+20 ;
+21 ;=========================================================
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.
+2 NEW FILTER,FLDS,RESULT
+3 KILL ^TMP($JOB,PLIST),^TMP($JOB,"SDAMA301")
+4 IF BDT<2000000
SET BDT=2000101
+5 SET FILTER(1)=BDT_";"_EDT
+6 SET FILTER("SORT")="P"
+7 ;Set the rest of the filter nodes.
+8 DO SFILTER(PARAM,.FILTER,.FLDS)
+9 ;DBIA #4433
+10 SET RESULT=$$SDAPI^SDAMA301(.FILTER)
+11 IF RESULT=-1
DO APPERR("Patient List build")
QUIT
+12 NEW COUNT,DATE,DFN,DONE,ITEM
+13 SET DFN=""
+14 FOR
SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))
if DFN=""
QUIT
Begin DoDot:1
+15 SET (COUNT,DONE)=0
SET DATE=""
+16 FOR
SET DATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,DATE),-1)
if (DONE)!(DATE="")
QUIT
Begin DoDot:2
+17 SET COUNT=COUNT+1
+18 SET ITEM=$PIECE(^TMP($JOB,"SDAMA301",DFN,DATE),U,2)
+19 SET ^TMP($JOB,PLIST,DFN,COUNT)=U_DATE_U_44_U_$PIECE(ITEM,";",1)_U_$PIECE(ITEM,";",2)
+20 IF COUNT=NGET
SET DONE=1
End DoDot:2
End DoDot:1
+21 KILL ^TMP($JOB,"SDAMA301"),^TMP($JOB,"HLOCL")
+22 QUIT
+23 ;
+24 ;=========================================================
FSTATUS(STATUS) ;Format the STATUS, field #22.
+1 NEW TEXT,TMP
+2 SET TMP=$PIECE(STATUS,";",1)
+3 SET TEXT=$SELECT(TMP="":"",1:"Code - "_TMP)
+4 SET TMP=$PIECE(STATUS,";",2)
+5 IF TMP'=""
SET TEXT=TEXT_"; Description - "_TMP
+6 SET TMP=$PIECE(STATUS,";",3)
+7 IF TMP'=""
SET TEXT=TEXT_"; Print Status - "_TMP
+8 SET TMP=$PIECE(STATUS,";",4)
+9 IF TMP'=""
SET TEXT=TEXT_"; Checked In Date/Time - "_$$EDATE^PXRMDATE(TMP)
+10 SET TMP=$PIECE(STATUS,";",5)
+11 IF TMP'=""
SET TEXT=TEXT_"; Checked Out Date/Time - "_$$EDATE^PXRMDATE(TMP)
+12 SET TMP=$PIECE(STATUS,";",6)
+13 IF TMP'=""
SET TEXT=TEXT_"; Admission Movement IFN - "_TMP
+14 QUIT TEXT
+15 ;
+16 ;=========================================================
PAPPL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,DATA,TEXT) ;Multiple type computed
+1 ;finding that returns a list appointments for a patient.
+2 NEW FIELD,FILTER,FLDS,PARAM,RESULT
+3 KILL ^TMP($JOB,"SDAMA301")
+4 SET PARAM=TEST
KILL TEST
+5 SET NFOUND=0
+6 IF BDT<2000000
SET BDT=2000101
+7 SET FILTER(1)=BDT_";"_EDT
+8 SET FILTER(4)=DFN
+9 SET FILTER("SORT")="P"
+10 ;Set the rest of the filter nodes.
+11 DO SFILTER(PARAM,.FILTER,.FLDS)
+12 ;DBIA #4433
+13 SET RESULT=$$SDAPI^SDAMA301(.FILTER)
+14 IF RESULT=-1
DO APPERR("Computed finding evaluation")
QUIT
+15 NEW ALLNULL,APPDATE,DATALIST,DONE,FLABEL,IND,ITEM,STATUS,TMP
+16 SET FLABEL(1)="APPOINTMENT DATE/TIME"
+17 SET FLABEL(2)="CLINIC"
+18 SET FLABEL(3)="APPOINTMENT STATUS"
+19 SET FLABEL(4)="PATIENT"
+20 SET FLABEL(5)="LENGTH OF APPOINTMENT"
+21 SET FLABEL(6)="COMMENTS"
+22 SET FLABEL(7)="OVERBOOK"
+23 SET FLABEL(8)="ELIGIBILITY OF VISIT"
+24 SET FLABEL(9)="CHECK-IN DATE/TIME"
+25 SET FLABEL(10)="APPOINTMENT TYPE"
+26 SET FLABEL(11)="CHECK-OUT DATE/TIME"
+27 SET FLABEL(12)="OUTPATIENT ENCOUNTER IEN"
+28 SET FLABEL(13)="PRIMARY STOP CODE"
+29 SET FLABEL(14)="CREDIT STOP CODE"
+30 SET FLABEL(15)="WORKLOAD NON-COUNT"
+31 SET FLABEL(16)="DATE APPOINTMENT MADE"
+32 SET FLABEL(17)="DESIRED DATE OF APPOINTMENT"
+33 SET FLABEL(18)="PURPOSE OF VISIT and SHORT DESCRIPTION"
+34 SET FLABEL(19)="EKG DATE/TIME"
+35 SET FLABEL(20)="X-RAY DATE/TIME"
+36 SET FLABEL(21)="LAB DATE/TIME"
+37 SET FLABEL(22)="STATUS"
+38 SET FLABEL(23)="X-RAY FILMS"
+39 SET FLABEL(24)="AUTO-REBOOKED APPOINTMENT DATE/TIME"
+40 SET FLABEL(25)="NO-SHOW/CANCEL DATE/TIME"
+41 SET FLABEL(26)="RSA APPOINTMENT ID"
+42 SET FLABEL(28)="DATA ENTRY CLERK"
+43 SET FLABEL(29)="NO-SHOW/CANCELED BY"
+44 SET FLABEL(30)="CHECK-IN USER"
+45 SET FLABEL(31)="CHECK-OUT USER"
+46 SET FLABEL(32)="CANCELLATION REASON"
+47 SET FLABEL(33)="CONSULT LINK"
+48 SET SDIR=$SELECT(NGET<0:1,1:-1)
+49 SET NGET=$SELECT(NGET<0:-NGET,1:NGET)
+50 SET APPDATE=""
SET DONE=0
+51 FOR
SET APPDATE=$ORDER(^TMP($JOB,"SDAMA301",DFN,APPDATE),SDIR)
if (DONE)!(APPDATE="")
QUIT
Begin DoDot:1
+52 SET NFOUND=NFOUND+1
+53 SET TEST(NFOUND)=1
SET DATE(NFOUND)=APPDATE
+54 ;Fields 1-26
+55 SET DATALIST=$GET(^TMP($JOB,"SDAMA301",DFN,APPDATE))
+56 ;Fields 28-33
+57 SET TMP=$GET(^TMP($JOB,"SDAMA301",DFN,APPDATE,0))
+58 SET ALLNULL=1
+59 IF TMP'=""
FOR IND=1:1:$LENGTH(TMP,U)
IF $PIECE(TMP,U,IND)'=""
SET ALLNULL=0
+60 IF 'ALLNULL
SET $PIECE(DATALIST,U,28)=TMP
+61 FOR IND=1:1:$LENGTH(DATALIST,U)
Begin DoDot:2
+62 SET FIELD=$PIECE(DATALIST,U,IND)
+63 IF IND=6
SET FIELD=$GET(^TMP($JOB,"SDAMA301",DFN,APPDATE,"C"))
+64 IF FIELD=""
QUIT
+65 IF IND=22
SET STATUS=FIELD
+66 IF FLABEL(IND)["DATE"
SET FIELD=$$EDATE^PXRMDATE(FIELD)
+67 IF FIELD[";"
SET FIELD=$PIECE(FIELD,";",2)
+68 ;Save the clinic as the value.
+69 IF IND=2
SET DATA(NFOUND,"VALUE")=FIELD
+70 IF IND=22
SET FIELD=$$FSTATUS(STATUS)
+71 SET TEXT(NFOUND,IND)=FLABEL(IND)_": "_FIELD
+72 SET DATA(NFOUND,FLABEL(IND))=FIELD
End DoDot:2
+73 IF NFOUND=NGET
SET DONE=1
End DoDot:1
+74 KILL ^TMP($JOB,"SDAMA301"),^TMP($JOB,"HLOCL")
+75 QUIT
+76 ;
+77 ;=========================================================
SFILTER(PARAM,FILTER,FLDS) ;Parse the PARMETER and set the appropriate
+1 ;fields.
+2 NEW IND,LLNAME,LLP,P1,P2,STATUS,TEMP
+3 SET (FLDS,LLNAME,STATUS)=""
+4 FOR IND=1:1:$LENGTH(PARAM,U)
Begin DoDot:1
+5 SET TEMP=$PIECE(PARAM,U,IND)
+6 SET P1=$PIECE(TEMP,":",1)
SET P2=$PIECE(TEMP,":",2)
+7 IF P1="FLDS"
SET FLDS=$TRANSLATE(P2,",",";")
QUIT
+8 IF P1="LL"
SET LLNAME=P2
QUIT
+9 IF P1="STATUS"
SET STATUS=$TRANSLATE(P2,",",";")
QUIT
End DoDot:1
+10 SET FILTER("FLDS")=$SELECT(FLDS="":"1;2",1:FLDS)
+11 SET FILTER(3)=$SELECT(STATUS="":"I;R",1:STATUS)
+12 IF LLNAME=""
QUIT
+13 SET LLP=$ORDER(^PXRMD(810.9,"B",LLNAME,""))
+14 ;The LL VA-ALL LOCATIONS means no clinic filter.
+15 IF LLNAME'="VA-ALL LOCATIONS"
DO LOCLIST^PXRMLOCF(LLP,"HLOCL")
+16 IF $DATA(^TMP($JOB,"HLOCL"))
SET FILTER(2)="^TMP($J,""HLOCL"","
+17 QUIT
+18 ;
+19 ;=========================================================
TFL(DFN,NGET,BDT,EDT,NFOUND,TEST,DATE,VALUE,TEXT) ;Multiple type computed
+1 ;finding for a patient's treating facility list.
+2 NEW DONE,IND,NOW,SDIR,TDATE,TFL,TFLD
+3 SET NFOUND=0
+4 ;DBIA #2990
+5 DO TFL^VAFCTFU1(.TFL,DFN)
+6 IF +TFL(1)=-1
QUIT
+7 SET NOW=$$NOW^PXRMDATE
+8 SET (DONE,IND)=0
+9 FOR
SET IND=$ORDER(TFL(IND))
if (DONE)!(IND="")
QUIT
Begin DoDot:1
+10 SET NFOUND=NFOUND+1
+11 SET TEST(NFOUND)=1
SET DATE(NFOUND)=NOW
+12 SET VALUE(NFOUND,"VALUE")=TFL(IND)
+13 IF NFOUND=NGET
SET DONE=1
QUIT
End DoDot:1
+14 FOR IND=1:1:NFOUND
SET VALUE(IND,"NUM FACILITIES")=NFOUND
+15 QUIT
+16 ;
