PXRMETCO ; SLC/PJH - QUERI Extract Compliance Report ;06/09/2009
;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
;
;
ADHOC(IEN,PXRMSTRT,PXRMSTOP) ;Ad Hoc Conformance Report
D DUMMY1^PXRMRUTL
Q
;
D JOB
Q
;
;BOOKMARK - cloned from PXRMETX, needs modifying to avoid patient list
;update. Build ^TMP("PXRMETX",$J) for report
;
REPORT ;Initialise
K ^TMP("PXRMETX",$J)
;Workfile node for ^TMP
S PXRMNODE="PXRMRULE"
;Get details from parameter file
N DATA,DATES,LIST,NAME,PARTYPE,TEXT
;N PERIOD,TEXT,YEAR
S DATA=$G(^PXRM(810.2,IEN,0))
;
;Determine Extract Name and period
S NAME=$P(DATA,U),PARTYPE=$P(DATA,U,2)
;S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
;Calculate report period start and end dates
;D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
;Determine output name for patient list and extract summary
S DATES=$$FMTE^XLFDT(PXRMSTRT)_" - "_$$FMTE^XLFDT(PXRMSTOP)
;
;Bookmark - Needs inventive patient list names
S LIST=NAME_" REPORT "_DATES
;Process (single) Denominator rule into patient list
N INDP,INTP,SEQ,SUB,SUFFIX
S SEQ=""
F S SEQ=$O(^PXRM(810.2,IEN,10,"B",SEQ)) Q:'SEQ D
.S SUB=$O(^PXRM(810.2,IEN,10,"B",SEQ,"")) Q:'SUB
.S DATA=$G(^PXRM(810.2,IEN,10,SUB,0)) Q:DATA=""
.S PXRMRULE=$P(DATA,U,2) Q:'PXRMRULE
.S SUFFIX=$P(DATA,U,3)
.I SUFFIX="" S SUFFIX="DENOMINATOR "_SEQ
.S INDP=+$P(DATA,U,4)
.S INTP=+$P(DATA,U,5)
.;Create new patient list
.S PXRMLIST=$$CRLST^PXRMRUL1(LIST_" "_SUFFIX) Q:'PXRMLIST
.D START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,INDP,INTP)
.;Clear ^TMP lists created for rule
.D CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
.;Process reminders
.D REM^PXRMETXR(SUB,PXRMLIST)
;
;Bookmark - Report stuff goes here
;Update totals section
N APPL,CNT,DUE,DATA,ETYP,EVAL
N FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FIND,FNAPPL,FNDUE,FSEQ
N NAPPL,NDUE,PXRMLIST,RCNT,RIEN,RSEQ,SEQ
S SEQ=0,CNT=1
F S SEQ=$O(^TMP("PXRMETX",$J,SEQ)) Q:'SEQ D
.S RCNT=0,RSEQ=0
.F S RCNT=$O(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'RCNT D
..S DATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT)) Q:'DATA
..S RIEN=$P(DATA,U),PXRMLIST=$P(DATA,U,5)
..S EVAL=$P(DATA,U,2),APPL=$P(DATA,U,3),DUE=$P(DATA,U,4)
..S NAPPL=EVAL-APPL,NDUE=APPL-DUE
..S CNT=CNT+1,RSEQ=RSEQ+1
..;bookmark - write patient line
..;For each count type
..S ETYP="",FCNT=CNT
..F S ETYP=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP)) Q:ETYP="" D
...;For each term
...S FIND=0,FSEQ=0
...F S FIND=$O(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)) Q:FIND="" D
....;Update finding totals
....S FDATA=$G(^TMP("PXRMETX",$J,SEQ,RCNT,ETYP,FIND)),FCNT=FCNT+1
....S FEVAL=$P(FDATA,U,2),FAPPL=$P(FDATA,U,3),FDUE=$P(FDATA,U,4)
....S FNAPPL=FEVAL-FAPPL,FNDUE=FAPPL-FDUE
....S FSEQ=FSEQ+1,FGNAM=$P(DATA,U,9)
....;Bookmark - write finding line
..;Update CNT
..S CNT=FCNT
Q
;
;Determine whether the report should be queued.
JOB ;
N DBDUZ,PXRMQUE
N %ZIS,ZTDESC,ZTSAVE,ZTRTN,ZTSK
S DBDUZ=DUZ
D SAVE^PXRMXQUE
S %ZIS="Q"
S ZTDESC="QUERI Compliance Report - print"
S ZTRTN="REPORT^PXRMETCO"
S ZTSK=1
S PXRMQUE=0
S PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK)
I PXRMQUE=1 G EXIT
I PXRMQUE>0 S ^XTMP(PXRMXTMP,"PRZTSK")=PXRMQUE
Q
;
EXIT ;Clean things up.
D ^%ZISC
D HOME^%ZIS
K IO("Q")
K DIRUT,DTOUT,DUOUT,POP,ZTREQ
I $D(ZTSK) D KILL^%ZTLOAD
K ZTSK,ZTQUEUED
K ^TMP("PXRMXTR",$J)
Q
;
SAVE ;Save the variables for queing.
S ZTSAVE("IEN")=""
S ZTSAVE("PXRMSTRT")=""
S ZTSAVE("PXRMSTOP")=""
Q
;
;
QUE ;BOOKMARK - NOT USED
;Queue the MST synchronization job.
N DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
S MINDT=$$NOW^XLFDT
W !,"Queue the Clinical Reminders MST synchronization."
S DIR("A",1)="Enter the date and time you want the job to start."
S DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
S DIR("A")="Start the task at: "
S DIR(0)="DAU"_U_MINDT_"::RSX"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
S SDTIME=Y
K DIR
S DIR(0)="YA"
S DIR("A")="Do you want to run the MST synchronization at the same time every day? "
S DIR("B")="Y"
D ^DIR
I $D(DTOUT)!$D(DUOUT) Q
I Y S STIME="1."_$P(SDTIME,".",2)
E S STIME=-1
;
;Put the task into the queue.
K ZTSAVE
;S ZTSAVE("START")=SDTIME
S ZTSAVE("STIME")=STIME
S ZTRTN="SYNCH^PXRMMST"
S ZTDESC="Clinical Reminders MST synchronization job"
S ZTDTH=SDTIME
S ZTIO=""
D ^%ZTLOAD
W !,"Task number ",ZTSK," queued."
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMETCO 4445 printed Oct 16, 2024@17:45:28 Page 2
PXRMETCO ; SLC/PJH - QUERI Extract Compliance Report ;06/09/2009
+1 ;;2.0;CLINICAL REMINDERS;**6,12**;Feb 04, 2005;Build 73
+2 ;
+3 ;
ADHOC(IEN,PXRMSTRT,PXRMSTOP) ;Ad Hoc Conformance Report
+1 DO DUMMY1^PXRMRUTL
+2 QUIT
+3 ;
+4 DO JOB
+5 QUIT
+6 ;
+7 ;BOOKMARK - cloned from PXRMETX, needs modifying to avoid patient list
+8 ;update. Build ^TMP("PXRMETX",$J) for report
+9 ;
REPORT ;Initialise
+1 KILL ^TMP("PXRMETX",$JOB)
+2 ;Workfile node for ^TMP
+3 SET PXRMNODE="PXRMRULE"
+4 ;Get details from parameter file
+5 NEW DATA,DATES,LIST,NAME,PARTYPE,TEXT
+6 ;N PERIOD,TEXT,YEAR
+7 SET DATA=$GET(^PXRM(810.2,IEN,0))
+8 ;
+9 ;Determine Extract Name and period
+10 SET NAME=$PIECE(DATA,U)
SET PARTYPE=$PIECE(DATA,U,2)
+11 ;S YEAR=$P(NEXT,"/",2),PERIOD=$P(NEXT,"/")
+12 ;Calculate report period start and end dates
+13 ;D CALC^PXRMEUT(NEXT,.PXRMSTRT,.PXRMSTOP)
+14 ;Determine output name for patient list and extract summary
+15 SET DATES=$$FMTE^XLFDT(PXRMSTRT)_" - "_$$FMTE^XLFDT(PXRMSTOP)
+16 ;
+17 ;Bookmark - Needs inventive patient list names
+18 SET LIST=NAME_" REPORT "_DATES
+19 ;Process (single) Denominator rule into patient list
+20 NEW INDP,INTP,SEQ,SUB,SUFFIX
+21 SET SEQ=""
+22 FOR
SET SEQ=$ORDER(^PXRM(810.2,IEN,10,"B",SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+23 SET SUB=$ORDER(^PXRM(810.2,IEN,10,"B",SEQ,""))
if 'SUB
QUIT
+24 SET DATA=$GET(^PXRM(810.2,IEN,10,SUB,0))
if DATA=""
QUIT
+25 SET PXRMRULE=$PIECE(DATA,U,2)
if 'PXRMRULE
QUIT
+26 SET SUFFIX=$PIECE(DATA,U,3)
+27 IF SUFFIX=""
SET SUFFIX="DENOMINATOR "_SEQ
+28 SET INDP=+$PIECE(DATA,U,4)
+29 SET INTP=+$PIECE(DATA,U,5)
+30 ;Create new patient list
+31 SET PXRMLIST=$$CRLST^PXRMRUL1(LIST_" "_SUFFIX)
if 'PXRMLIST
QUIT
+32 DO START^PXRMRULE(PXRMRULE,PXRMLIST,PXRMNODE,PXRMSTRT,PXRMSTOP,IEN,INDP,INTP)
+33 ;Clear ^TMP lists created for rule
+34 DO CLEAR^PXRMRULE(PXRMRULE,PXRMNODE)
+35 ;Process reminders
+36 DO REM^PXRMETXR(SUB,PXRMLIST)
End DoDot:1
+37 ;
+38 ;Bookmark - Report stuff goes here
+39 ;Update totals section
+40 NEW APPL,CNT,DUE,DATA,ETYP,EVAL
+41 NEW FAPPL,FCNT,FDATA,FDUE,FEVAL,FGNAM,FIND,FNAPPL,FNDUE,FSEQ
+42 NEW NAPPL,NDUE,PXRMLIST,RCNT,RIEN,RSEQ,SEQ
+43 SET SEQ=0
SET CNT=1
+44 FOR
SET SEQ=$ORDER(^TMP("PXRMETX",$JOB,SEQ))
if 'SEQ
QUIT
Begin DoDot:1
+45 SET RCNT=0
SET RSEQ=0
+46 FOR
SET RCNT=$ORDER(^TMP("PXRMETX",$JOB,SEQ,RCNT))
if 'RCNT
QUIT
Begin DoDot:2
+47 SET DATA=$GET(^TMP("PXRMETX",$JOB,SEQ,RCNT))
if 'DATA
QUIT
+48 SET RIEN=$PIECE(DATA,U)
SET PXRMLIST=$PIECE(DATA,U,5)
+49 SET EVAL=$PIECE(DATA,U,2)
SET APPL=$PIECE(DATA,U,3)
SET DUE=$PIECE(DATA,U,4)
+50 SET NAPPL=EVAL-APPL
SET NDUE=APPL-DUE
+51 SET CNT=CNT+1
SET RSEQ=RSEQ+1
+52 ;bookmark - write patient line
+53 ;For each count type
+54 SET ETYP=""
SET FCNT=CNT
+55 FOR
SET ETYP=$ORDER(^TMP("PXRMETX",$JOB,SEQ,RCNT,ETYP))
if ETYP=""
QUIT
Begin DoDot:3
+56 ;For each term
+57 SET FIND=0
SET FSEQ=0
+58 FOR
SET FIND=$ORDER(^TMP("PXRMETX",$JOB,SEQ,RCNT,ETYP,FIND))
if FIND=""
QUIT
Begin DoDot:4
+59 ;Update finding totals
+60 SET FDATA=$GET(^TMP("PXRMETX",$JOB,SEQ,RCNT,ETYP,FIND))
SET FCNT=FCNT+1
+61 SET FEVAL=$PIECE(FDATA,U,2)
SET FAPPL=$PIECE(FDATA,U,3)
SET FDUE=$PIECE(FDATA,U,4)
+62 SET FNAPPL=FEVAL-FAPPL
SET FNDUE=FAPPL-FDUE
+63 SET FSEQ=FSEQ+1
SET FGNAM=$PIECE(DATA,U,9)
+64 ;Bookmark - write finding line
End DoDot:4
End DoDot:3
+65 ;Update CNT
+66 SET CNT=FCNT
End DoDot:2
End DoDot:1
+67 QUIT
+68 ;
+69 ;Determine whether the report should be queued.
JOB ;
+1 NEW DBDUZ,PXRMQUE
+2 NEW %ZIS,ZTDESC,ZTSAVE,ZTRTN,ZTSK
+3 SET DBDUZ=DUZ
+4 DO SAVE^PXRMXQUE
+5 SET %ZIS="Q"
+6 SET ZTDESC="QUERI Compliance Report - print"
+7 SET ZTRTN="REPORT^PXRMETCO"
+8 SET ZTSK=1
+9 SET PXRMQUE=0
+10 SET PXRMQUE=$$DEVICE^PXRMXQUE(ZTRTN,ZTDESC,.ZTSAVE,.%ZIS,.ZTSK)
+11 IF PXRMQUE=1
GOTO EXIT
+12 IF PXRMQUE>0
SET ^XTMP(PXRMXTMP,"PRZTSK")=PXRMQUE
+13 QUIT
+14 ;
EXIT ;Clean things up.
+1 DO ^%ZISC
+2 DO HOME^%ZIS
+3 KILL IO("Q")
+4 KILL DIRUT,DTOUT,DUOUT,POP,ZTREQ
+5 IF $DATA(ZTSK)
DO KILL^%ZTLOAD
+6 KILL ZTSK,ZTQUEUED
+7 KILL ^TMP("PXRMXTR",$JOB)
+8 QUIT
+9 ;
SAVE ;Save the variables for queing.
+1 SET ZTSAVE("IEN")=""
+2 SET ZTSAVE("PXRMSTRT")=""
+3 SET ZTSAVE("PXRMSTOP")=""
+4 QUIT
+5 ;
+6 ;
QUE ;BOOKMARK - NOT USED
+1 ;Queue the MST synchronization job.
+2 NEW DIR,DTOUT,DUOUT,MINDT,SDTIME,STIME,X,Y
+3 SET MINDT=$$NOW^XLFDT
+4 WRITE !,"Queue the Clinical Reminders MST synchronization."
+5 SET DIR("A",1)="Enter the date and time you want the job to start."
+6 SET DIR("A",2)="It must be after "_$$FMTE^XLFDT(MINDT,"5Z")
+7 SET DIR("A")="Start the task at: "
+8 SET DIR(0)="DAU"_U_MINDT_"::RSX"
+9 DO ^DIR
+10 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+11 SET SDTIME=Y
+12 KILL DIR
+13 SET DIR(0)="YA"
+14 SET DIR("A")="Do you want to run the MST synchronization at the same time every day? "
+15 SET DIR("B")="Y"
+16 DO ^DIR
+17 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+18 IF Y
SET STIME="1."_$PIECE(SDTIME,".",2)
+19 IF '$TEST
SET STIME=-1
+20 ;
+21 ;Put the task into the queue.
+22 KILL ZTSAVE
+23 ;S ZTSAVE("START")=SDTIME
+24 SET ZTSAVE("STIME")=STIME
+25 SET ZTRTN="SYNCH^PXRMMST"
+26 SET ZTDESC="Clinical Reminders MST synchronization job"
+27 SET ZTDTH=SDTIME
+28 SET ZTIO=""
+29 DO ^%ZTLOAD
+30 WRITE !,"Task number ",ZTSK," queued."
+31 QUIT
