Routine: PXRMETCO

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

 D JOB

 ;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

 ;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

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)

SAVE ;Save the variables for queing.

 S ZTSAVE("IEN")=""

 S ZTSAVE("PXRMSTRT")=""

 S ZTSAVE("PXRMSTOP")=""

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."

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

PXRMETCO.m