- PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report; 05/13/2016
- ;;2.0;CLINICAL REMINDERS;**4,6,12,26,47**;Feb 04, 2005;Build 291
- ;
- ; Called/jobbed from PXRMXD
- ;
- ; Input - PXRMSEL,PXRMXTMP
- ; PXRM*
- ; Output- ^XTMP(PXRMXTMP
- ;
- ;
- START ;
- N LIT,TOTAL,TODAY,ZTSTOP,BUSY
- S DBDOWN=0
- S TOTAL=0,ZTSTOP="",TODAY=$$DT^XLFDT-.0001
- ;
- K ^TMP($J,"PXRM PATIENT LIST"),^TMP($J,"PXRM PATIENT EVAL")
- K ^TMP($J,"PXRM FUTURE APPT"),^TMP($J,"SDAMA301")
- K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
- K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J)
- K ^TMP("PXRMCMB3",$J),^TMP("PXRMCMB4",$J)
- N PXRMRERR
- ;
- ;Initialize the busy counter.
- S BUSY=0
- ;
- ;OE/RR team selected (PXRMOTM)
- I PXRMSEL="O" D OERR^PXRMXSL1
- ;
- ;PCMM team selected (PXRMPCM)
- I PXRMSEL="T" D PCMMT^PXRMXSL1
- ;
- N HLIEN,FACILITY
- ;Location selected (PXRMLCHL,PXRMCGRP)
- I PXRMSEL="L" D G:ZTSTOP=1 EXIT
- .;Build Clinic List
- .D BHLOC^PXRMXSL1
- .;Prior Visits - build patient list in ^TMP
- .I PXRMFD="P" D VISITS^PXRMXSL2 I DBDOWN=1 Q
- .;Inpatient Admissions and current inpatient locations
- .I PXRMFD="A"!(PXRMFD="C") D INPADM^PXRMXSL1
- .;Future Appointments - build patient list in ^TMP
- .I PXRMFD="F" D APPTS^PXRMXSL2 I DBDOWN=1 Q
- .;End task requested
- .Q:ZTSTOP=1
- ;Update ^XTMP from ^TMP
- ;Initialize the busy counter.
- S BUSY=0
- ;
- ;PCMM provider selected (PXRMPRV)
- I PXRMSEL="P" D PCMMP^PXRMXSL1
- ;
- ;Individual Patients selected (PXRMPAT)
- I PXRMSEL="I" D IND^PXRMXSL1
- ;
- ;Patient List selected (PXRMLIST)
- I PXRMSEL="R" D LIST^PXRMXSL1
- ;
- I DBDOWN=1 G EXIT
- S START=$H
- D EVAL^PXRMXEVL("PXRM PATIENT EVAL",.REMINDER)
- D XTMP(START)
- ;
- ;Update patient list
- I PXRMSEL'="I"&(PXRMUSER'="Y")&($G(PXRMLIS1)'="") D
- .;If no patients due delete patient list
- .I +$O(^TMP($J,"PXRMXPAT",""))=0 D Q
- ..N DA,DIK S DA=PXRMLIS1,DIK="^PXRMXP(810.5," D ^DIK
- .;Otherwise create patient list
- .D UPDLST^PXRMRULE("PXRMXPAT",PXRMLIS1,"","","",PXRMDPAT,PXRMTPAT)
- .S $P(^PXRMXP(810.5,PXRMLIS1,0),U,9)=1
- K ^TMP($J,"PXRMXPAT")
- K ^TMP($J),^TMP(PXRMRT,$J),^TMP("PXRMDUP",$J)
- K ^TMP("PXRMCMB",$J),^TMP("PXRMCMB1",$J),^TMP("PXRMCMB2",$J)
- K ^TMP("PXRMCMB3",$J),^TMP("PXRMCMB4",$J)
- K DBDOWN
- ;Sorting is done, produce the output.
- D START^PXRMXPR
- Q
- ;
- ERROR(STATUS,ITEM) ;
- ;Create XTMP entry for Reminders that error out or could not be
- ;determing on evaluation
- N ERRNAME
- S STATUS=$P(STATUS,U)
- S ERRNAME=$P(^PXD(811.9,ITEM,0),U)
- I $D(^XTMP(PXRMXTMP,STATUS,ERRNAME))>0,^XTMP(PXRMXTMP,STATUS,ERRNAME)>0 D
- .S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=^XTMP(PXRMXTMP,STATUS,ERRNAME)+1
- E S ^XTMP(PXRMXTMP,STATUS,ERRNAME)=1
- Q
- ;
- ;End Task requested
- EXIT ;
- S ZTSK=$G(^XTMP(PXRMXTMP,"PRZTSK"))
- I ZTSK>0 D KILL^%ZTLOAD
- D EXIT^PXRMXGUT
- K DBDOWN
- Q
- ;
- XTMP(START) ;
- N CNT,CCNT,DDAT,II,INP,ITEM,LIT,LOC,LSSN,MCNBD,MCNBDR,NAME
- N SUB,STATUS,TEMP,TEXT
- K ^TMP($J,"PXRM CNBD")
- S CCNT=0,MCNBD=$G(^PXRM(800,1,"MIERR")),MCNBDR=0
- S BUSY=0,SUB="NAM",TEMP=0,PX="PXRM"
- N DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM
- S FACILITY="",DDAT="N/A"
- F S FACILITY=$O(^TMP(PXRMRT,$J,FACILITY)) Q:FACILITY="" D
- .S NAM=""
- .F S NAM=$O(^TMP(PXRMRT,$J,FACILITY,NAM)) Q:NAM="" D
- ..S LOC=""
- ..F S LOC=$O(^TMP(PXRMRT,$J,FACILITY,NAM,LOC)) Q:LOC="" D
- ...S DFN=""
- ...F S DFN=$O(^TMP(PXRMRT,$J,FACILITY,NAM,LOC,DFN)) Q:DFN="" D
- ....D NOTIFY^PXRMXBSY("Evaluating reminders",.BUSY)
- ....S INP=$G(^TMP(PXRMRT,$J,FACILITY,NAM,LOC,DFN))
- ....S CNT=0 F S CNT=$O(REMINDER(CNT)) Q:CNT'>0 D
- .....S ITEM=$P(REMINDER(CNT),U,1),LIT=$P(REMINDER(CNT),U,4)
- .....I LIT="" S LIT=$P(REMINDER(CNT),U,2)
- .....S STATUS=$G(^TMP($J,"PXRM PATIENT EVAL",DFN,ITEM))
- .....I STATUS="" Q
- .....I STATUS["ERROR"!(STATUS["CNBD") D
- ......D ERROR(STATUS,ITEM) I STATUS["ERROR"!(MCNBDR=1) Q
- ......I CCNT=0 D
- .......S ^TMP($J,"PXRM CNBD",1,0)=" "_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",8)_" REMINDER"
- .......S TEMP=" "
- .......F II=1:1:30 S TEMP=TEMP_"-"
- .......S TEMP=TEMP_" "
- .......F II=1:1:6 S TEMP=TEMP_"-"
- .......S TEMP=TEMP_" "
- .......F II=1:1:30 S TEMP=TEMP_"-"
- .......S ^TMP($J,"PXRM CNBD",2,0)=TEMP
- .......S CCNT=2
- ......S CCNT=CCNT+1
- ......I CCNT>MCNBD S MCNBDR=1 Q
- ......S NAME=$P(^DPT(DFN,0),U)
- ......S LSSN=$E($P(^DPT(DFN,0),U,9),6,9)
- ......S ^TMP($J,"PXRM CNBD",CCNT,0)=" "_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,8)_" "_$$LJ^XLFSTR(LIT,30)
- .....;Add reminder status to patient list TMP Global
- .....I STATUS["DUE NOW" S ^TMP($J,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS
- .....I PXRMREP="D" D SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP)
- .....I PXRMREP="S" D SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM,LOC)
- I $D(^TMP($J,"PXRM CNBD"))>0 D ERRMSG^PXRMXDT1("C")
- K ^TMP($J,"PXRM CNBD")
- S TEXT="Elapsed time for reminder evaluation: "_$$DETIME^PXRMXSL1(START,$H)
- S ^XTMP(PXRMXTMP,"TIMING","REMINDER EVALUATION")=TEXT
- I '(PXRMQUE!$D(IO("S"))!(PXRMTABS="Y")) W !,TEXT
- K ^TMP($J,"PXRM PATIENT EVAL")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMXSE1 5042 printed Apr 23, 2025@18:04:48 Page 2
- PXRMXSE1 ; SLC/PJH - Build Patient lists for Reminder Due report; 05/13/2016
- +1 ;;2.0;CLINICAL REMINDERS;**4,6,12,26,47**;Feb 04, 2005;Build 291
- +2 ;
- +3 ; Called/jobbed from PXRMXD
- +4 ;
- +5 ; Input - PXRMSEL,PXRMXTMP
- +6 ; PXRM*
- +7 ; Output- ^XTMP(PXRMXTMP
- +8 ;
- +9 ;
- START ;
- +1 NEW LIT,TOTAL,TODAY,ZTSTOP,BUSY
- +2 SET DBDOWN=0
- +3 SET TOTAL=0
- SET ZTSTOP=""
- SET TODAY=$$DT^XLFDT-.0001
- +4 ;
- +5 KILL ^TMP($JOB,"PXRM PATIENT LIST"),^TMP($JOB,"PXRM PATIENT EVAL")
- +6 KILL ^TMP($JOB,"PXRM FUTURE APPT"),^TMP($JOB,"SDAMA301")
- +7 KILL ^TMP($JOB),^TMP(PXRMRT,$JOB),^TMP("PXRMDUP",$JOB)
- +8 KILL ^TMP("PXRMCMB",$JOB),^TMP("PXRMCMB1",$JOB),^TMP("PXRMCMB2",$JOB)
- +9 KILL ^TMP("PXRMCMB3",$JOB),^TMP("PXRMCMB4",$JOB)
- +10 NEW PXRMRERR
- +11 ;
- +12 ;Initialize the busy counter.
- +13 SET BUSY=0
- +14 ;
- +15 ;OE/RR team selected (PXRMOTM)
- +16 IF PXRMSEL="O"
- DO OERR^PXRMXSL1
- +17 ;
- +18 ;PCMM team selected (PXRMPCM)
- +19 IF PXRMSEL="T"
- DO PCMMT^PXRMXSL1
- +20 ;
- +21 NEW HLIEN,FACILITY
- +22 ;Location selected (PXRMLCHL,PXRMCGRP)
- +23 IF PXRMSEL="L"
- Begin DoDot:1
- +24 ;Build Clinic List
- +25 DO BHLOC^PXRMXSL1
- +26 ;Prior Visits - build patient list in ^TMP
- +27 IF PXRMFD="P"
- DO VISITS^PXRMXSL2
- IF DBDOWN=1
- QUIT
- +28 ;Inpatient Admissions and current inpatient locations
- +29 IF PXRMFD="A"!(PXRMFD="C")
- DO INPADM^PXRMXSL1
- +30 ;Future Appointments - build patient list in ^TMP
- +31 IF PXRMFD="F"
- DO APPTS^PXRMXSL2
- IF DBDOWN=1
- QUIT
- +32 ;End task requested
- +33 if ZTSTOP=1
- QUIT
- End DoDot:1
- if ZTSTOP=1
- GOTO EXIT
- +34 ;Update ^XTMP from ^TMP
- +35 ;Initialize the busy counter.
- +36 SET BUSY=0
- +37 ;
- +38 ;PCMM provider selected (PXRMPRV)
- +39 IF PXRMSEL="P"
- DO PCMMP^PXRMXSL1
- +40 ;
- +41 ;Individual Patients selected (PXRMPAT)
- +42 IF PXRMSEL="I"
- DO IND^PXRMXSL1
- +43 ;
- +44 ;Patient List selected (PXRMLIST)
- +45 IF PXRMSEL="R"
- DO LIST^PXRMXSL1
- +46 ;
- +47 IF DBDOWN=1
- GOTO EXIT
- +48 SET START=$HOROLOG
- +49 DO EVAL^PXRMXEVL("PXRM PATIENT EVAL",.REMINDER)
- +50 DO XTMP(START)
- +51 ;
- +52 ;Update patient list
- +53 IF PXRMSEL'="I"&(PXRMUSER'="Y")&($GET(PXRMLIS1)'="")
- Begin DoDot:1
- +54 ;If no patients due delete patient list
- +55 IF +$ORDER(^TMP($JOB,"PXRMXPAT",""))=0
- Begin DoDot:2
- +56 NEW DA,DIK
- SET DA=PXRMLIS1
- SET DIK="^PXRMXP(810.5,"
- DO ^DIK
- End DoDot:2
- QUIT
- +57 ;Otherwise create patient list
- +58 DO UPDLST^PXRMRULE("PXRMXPAT",PXRMLIS1,"","","",PXRMDPAT,PXRMTPAT)
- +59 SET $PIECE(^PXRMXP(810.5,PXRMLIS1,0),U,9)=1
- End DoDot:1
- +60 KILL ^TMP($JOB,"PXRMXPAT")
- +61 KILL ^TMP($JOB),^TMP(PXRMRT,$JOB),^TMP("PXRMDUP",$JOB)
- +62 KILL ^TMP("PXRMCMB",$JOB),^TMP("PXRMCMB1",$JOB),^TMP("PXRMCMB2",$JOB)
- +63 KILL ^TMP("PXRMCMB3",$JOB),^TMP("PXRMCMB4",$JOB)
- +64 KILL DBDOWN
- +65 ;Sorting is done, produce the output.
- +66 DO START^PXRMXPR
- +67 QUIT
- +68 ;
- ERROR(STATUS,ITEM) ;
- +1 ;Create XTMP entry for Reminders that error out or could not be
- +2 ;determing on evaluation
- +3 NEW ERRNAME
- +4 SET STATUS=$PIECE(STATUS,U)
- +5 SET ERRNAME=$PIECE(^PXD(811.9,ITEM,0),U)
- +6 IF $DATA(^XTMP(PXRMXTMP,STATUS,ERRNAME))>0
- IF ^XTMP(PXRMXTMP,STATUS,ERRNAME)>0
- Begin DoDot:1
- +7 SET ^XTMP(PXRMXTMP,STATUS,ERRNAME)=^XTMP(PXRMXTMP,STATUS,ERRNAME)+1
- End DoDot:1
- +8 IF '$TEST
- SET ^XTMP(PXRMXTMP,STATUS,ERRNAME)=1
- +9 QUIT
- +10 ;
- +11 ;End Task requested
- EXIT ;
- +1 SET ZTSK=$GET(^XTMP(PXRMXTMP,"PRZTSK"))
- +2 IF ZTSK>0
- DO KILL^%ZTLOAD
- +3 DO EXIT^PXRMXGUT
- +4 KILL DBDOWN
- +5 QUIT
- +6 ;
- XTMP(START) ;
- +1 NEW CNT,CCNT,DDAT,II,INP,ITEM,LIT,LOC,LSSN,MCNBD,MCNBDR,NAME
- +2 NEW SUB,STATUS,TEMP,TEXT
- +3 KILL ^TMP($JOB,"PXRM CNBD")
- +4 SET CCNT=0
- SET MCNBD=$GET(^PXRM(800,1,"MIERR"))
- SET MCNBDR=0
- +5 SET BUSY=0
- SET SUB="NAM"
- SET TEMP=0
- SET PX="PXRM"
- +6 NEW DDAT,DDUE,DEMARR,DFN,DLAST,DNEXT,FACILITY,NAM,PNAM
- +7 SET FACILITY=""
- SET DDAT="N/A"
- +8 FOR
- SET FACILITY=$ORDER(^TMP(PXRMRT,$JOB,FACILITY))
- if FACILITY=""
- QUIT
- Begin DoDot:1
- +9 SET NAM=""
- +10 FOR
- SET NAM=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM))
- if NAM=""
- QUIT
- Begin DoDot:2
- +11 SET LOC=""
- +12 FOR
- SET LOC=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC))
- if LOC=""
- QUIT
- Begin DoDot:3
- +13 SET DFN=""
- +14 FOR
- SET DFN=$ORDER(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC,DFN))
- if DFN=""
- QUIT
- Begin DoDot:4
- +15 DO NOTIFY^PXRMXBSY("Evaluating reminders",.BUSY)
- +16 SET INP=$GET(^TMP(PXRMRT,$JOB,FACILITY,NAM,LOC,DFN))
- +17 SET CNT=0
- FOR
- SET CNT=$ORDER(REMINDER(CNT))
- if CNT'>0
- QUIT
- Begin DoDot:5
- +18 SET ITEM=$PIECE(REMINDER(CNT),U,1)
- SET LIT=$PIECE(REMINDER(CNT),U,4)
- +19 IF LIT=""
- SET LIT=$PIECE(REMINDER(CNT),U,2)
- +20 SET STATUS=$GET(^TMP($JOB,"PXRM PATIENT EVAL",DFN,ITEM))
- +21 IF STATUS=""
- QUIT
- +22 IF STATUS["ERROR"!(STATUS["CNBD")
- Begin DoDot:6
- +23 DO ERROR(STATUS,ITEM)
- IF STATUS["ERROR"!(MCNBDR=1)
- QUIT
- +24 IF CCNT=0
- Begin DoDot:7
- +25 SET ^TMP($JOB,"PXRM CNBD",1,0)=" "_$$LJ^XLFSTR("PATIENT NAME",30)_$$RJ^XLFSTR("LAST 4",8)_" REMINDER"
- +26 SET TEMP=" "
- +27 FOR II=1:1:30
- SET TEMP=TEMP_"-"
- +28 SET TEMP=TEMP_" "
- +29 FOR II=1:1:6
- SET TEMP=TEMP_"-"
- +30 SET TEMP=TEMP_" "
- +31 FOR II=1:1:30
- SET TEMP=TEMP_"-"
- +32 SET ^TMP($JOB,"PXRM CNBD",2,0)=TEMP
- +33 SET CCNT=2
- End DoDot:7
- +34 SET CCNT=CCNT+1
- +35 IF CCNT>MCNBD
- SET MCNBDR=1
- QUIT
- +36 SET NAME=$PIECE(^DPT(DFN,0),U)
- +37 SET LSSN=$EXTRACT($PIECE(^DPT(DFN,0),U,9),6,9)
- +38 SET ^TMP($JOB,"PXRM CNBD",CCNT,0)=" "_$$LJ^XLFSTR(NAME,30)_$$RJ^XLFSTR(LSSN,8)_" "_$$LJ^XLFSTR(LIT,30)
- End DoDot:6
- +39 ;Add reminder status to patient list TMP Global
- +40 IF STATUS["DUE NOW"
- SET ^TMP($JOB,"PXRMXPAT",DFN,"REM",ITEM)=ITEM_U_STATUS
- +41 IF PXRMREP="D"
- DO SDET^PXRMXDT1(DFN,STATUS,NAM,FACILITY,INP)
- +42 IF PXRMREP="S"
- DO SUM^PXRMXDT1(DFN,STATUS,FACILITY,NAM,LOC)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +43 IF $DATA(^TMP($JOB,"PXRM CNBD"))>0
- DO ERRMSG^PXRMXDT1("C")
- +44 KILL ^TMP($JOB,"PXRM CNBD")
- +45 SET TEXT="Elapsed time for reminder evaluation: "_$$DETIME^PXRMXSL1(START,$HOROLOG)
- +46 SET ^XTMP(PXRMXTMP,"TIMING","REMINDER EVALUATION")=TEXT
- +47 IF '(PXRMQUE!$DATA(IO("S"))!(PXRMTABS="Y"))
- WRITE !,TEXT
- +48 KILL ^TMP($JOB,"PXRM PATIENT EVAL")
- +49 QUIT
- +50 ;
