LREPIRS.m

LREPIRS ;VA/DALOI/CKA - EPI-LOCAL REPORT/SPREADSHEET ; 5/14/03

 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 ;;5.2;LAB SERVICE;**281**;Sep 27, 1994

 ; Reference to ^ORD(101 supported by IA #872

 ;USED TO PRINT REPORT OR SPREADSHEET 

 D NOW^%DTC

 S LRLRDT=% ;Set LRLRDT- local report date time=now

 S LRRTYPE=1,LRPROT=0

 S LRPROT=$O(^ORD(101,"B","LREPI",LRPROT))

 W @IOF,?(IOM/2-15),"Laboratory Generate Local Report/Spreadsheet option"

CRI K LRCYCLE,LREPI S LRMSG="Pathogens" D ALL G:$D(DIRUT) EXIT

 K DIR,DIRUT,DTOUT,DUOUT,DIROUT

 I +LRALL D PICKALL G DATE

 S LRMSG="Local Pathogens" D ALL G:$D(DIRUT) CRI

 K DIR,DIRUT,DTOUT,DUOUT,DIROUT

 I +LRALL D LOCALL G DATE

 I +LRALL'>0 D

 .W @IOF

 .F  Q:$D(DIRUT)  D

 ..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Pathogens: "

 ..S DIR("S")="D CHKL^LREPIRM I LROK I $P(^(0),U,7)=LRPROT"

 ..D ^DIR

 ..Q:$D(DIRUT)

 ..S LREPI(+Y)=""

 G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) CRI

 I '$D(LREPI) W !,"Sorry No Pathogens Selected" G EXIT

DATE ;Select Search Date

 K DIR,DIRUT

 S DIR("A")="Select Start Date: "

 S DIR(0)="DOA^:"_DT D ^DIR

 G:$D(DIRUT) CRI

 S LRRPS=Y

 K DIR,DIRUT

 S DIR("A")="Select End Date: "

 S DIR(0)="DOA^:"_DT D ^DIR

 G:$D(DIRUT) DATE

 S LRRPE=Y

RORS ;REPORT OR SPREADSHEET

 K DIR,DIRUT

 S DIR(0)="SO^1:REPORT;2:SPREADSHEET"

 D ^DIR

 G:$D(DIRUT) DATE

 S LRREP=Y

 W !!

 I LRREP=1,$D(^XTMP("LREPILOCALREP"_LRLRDT)) D  G EXIT

 .W !,"Data already exists for this date and time.  Please try again later."

 I LRREP=2,$D(^XTMP("LREPILOCALSPSHT"_LRLRDT)) D  G EXIT

 .W !,"Data already exists for this date and time.  Please try again later."

 D SEG G:$D(DIRUT) RORS

TITLE K DIR,DIRUT

 S DIR(0)="F^3:30",DIR("A")="DOCUMENT TITLE"

 D ^DIR

 G:$D(DIRUT) RORS

 S ^XTMP("LREPI"_$S(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDT,"TITLE")=Y

 D TASK,HOME^%ZIS

EXIT ;

 K D0,J,LRALL,LRAUTO,LRBEG,LRCYCLE,LRDT,LREND,LREPI,LRMSG,LROK,LROVR

 K LRDUZ,LRRNDT,LRRPE,LRREP,LRRPS,LRRTYPE,LRY,ZTSAVE

 K ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT

 K LRLC,LRHDG,LRPROT,LRLRDT

 K DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LRSEG

 K ^TMP($J)

 Q

 ;

TASK ;LETS TASK THIS JOB

 Q:'$D(LREPI)

 W !!

 S LRDUZ=DUZ

 K ZTSAVE

 S ZTSAVE("LRRTYPE")="" S:LRRTYPE=0 ZTDTH=DT

 S ZTSAVE("LR*")=""

 S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory EPI local spreadsheet/report-generate"

 D ^%ZTLOAD

 I '$D(ZTQUEUED)&($D(ZTSK)) W @IOF,!!,"The Task has been queued",!,"Task # ",$G(ZTSK) H 5

 Q

PICKALL ;SELECT ALL ASSOCIATED PARAMETERS

 S Y=0 F  S Y=$O(^LAB(69.5,Y)) Q:+Y'>0  D CHK S:LROK LREPI(Y)=""

 Q

LOCALL ;SELECT ALL LOCAL PATHOGENS

 S Y=99 F  S Y=$O(^LAB(69.5,Y)) Q:Y'>0  D CHK S:LROK LREPI(Y)=""

 Q

CHK ;CHECK TO SEE IF ITS OK

 S:'$D(LRCYCLE) LRCYCLE=$P(^LAB(69.5,Y,0),U,5)

 S LROK=1

 S:($P(^LAB(69.5,Y,0),U,2)="1") LROK=0 Q

 S:$P(^LAB(69.5,Y,0),U,7)="" LROK=0 Q

 S:'$D(^ORD(101,$P(^LAB(69.5,Y,0),U,7),0)) LROK=0 Q

 S:$P(^LAB(69.5,Y,0),U,5)=LRCYCLE LROK=0 Q

 Q

ALL K DIR,DIRUT

 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include All "_LRMSG

 S DIR("?")="Enter (Y)es or return to individually select pathogens."

 D ^DIR

 S LRALL=+Y

 Q

SEG ;CHOOSE SEGMENTS FOR SPREADSHEET

 W !,"Choose the segments to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 W !,"1-PID"

 W !,"2-PV1"

 W !,"3-DG1"

 W !,"4-NTE"

 W !,"5-OBR"

 W !,"6-OBX"

 K DIR,DIRUT

 S DIR(0)="L^1:6"

 D ^DIR

 Q:$D(DIRUT)

 S LRY=Y

 I LRY[1 S LRSEG("PID")=1 D

 .W !!

 .W !,"Choose the fields from the PID segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-SSN"

 .W !,"3-MPI"

 .W !,"4-Patient Name"

 .W !,"5-Date of Birth"

 .W !,"6-Sex"

 .W !,"7-Race"

 .W !,"8-Homeless"

 .W !,"9-State"

 .W !,"10-Zip Code"

 .W !,"11-County"

 .W !,"12-Ethnicity"

 .W !,"13-Period of Service"

 .K DIR,DIRUT

 .S DIR(0)="L^1:13"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:13 I Y[I S LRSEG("PID",I)=""

 I LRY[2 S LRSEG("PV1")=1 D

 .W !,"Choose the fields from the PV1 segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-Patient Class"

 .W !,"3-Hospital Location"

 .W !,"4-Discharge Disposition"

 .W !,"5-Facility"

 .W !,"6-Admit Date/Time"

 .W !,"7-Discharge Date/Time"

 .K DIR,DIRUT

 .S DIR(0)="L^1:7"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:7 I Y[I S LRSEG("PV1",I)=""

 I LRY[3 S LRSEG("DG1")=1 D

 .W !,"Choose the fields from the DG1 segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-Diagnosis Code"

 .W !,"3-Diagnosis"

 .W !,"4-Admission Date"

 .K DIR,DIRUT

 .S DIR(0)="L^1:4"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:4 I Y[I S LRSEG("DG1",I)=""

 I LRY[4 S LRSEG("NTE")=1 D

 .W !,"Choose the fields from the NTE segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-Comment"

 .K DIR,DIRUT

 .S DIR(0)="L^1:2"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:2 I Y[I S LRSEG("NTE",I)=""

 I LRY[5 S LRSEG("OBR")=1 D

 .W !,"Choose the fields from the OBR segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-Test Name"

 .W !,"3-Accession Date"

 .W !,"4-Specimen"

 .W !,"5-Accession Number"

 .K DIR,DIRUT

 .S DIR(0)="L^1:5"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:5 I Y[I S LRSEG("OBR",I)=""

 I LRY[6 S LRSEG("OBX")=1 D

 .W !,"Choose the fields from the OBX segment to capture for ",$S(LRREP=1:"report.",1:"spreadsheet.")

 .W !,"1-Set Id"

 .W !,"2-Value Type"

 .W !,"3-Test Name"

 .W !,"4-LOINC Code"

 .W !,"5-LOINC Name"

 .W !,"6-Test Result"

 .W !,"7-Units"

 .W !,"8-Abnormal Flags"

 .W !,"9-Verified Date/Time"

 .K DIR,DIRUT

 .S DIR(0)="L^1:9"

 .D ^DIR

 .Q:$D(DIRUT)

 .F I=1:1:10 I Y[I S LRSEG("OBX",I)=""

 Q

LREPIRS   ;VA/DALOI/CKA - EPI-LOCAL REPORT/SPREADSHEET ; 5/14/03

 +1       ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997

 +2       ;;5.2;LAB SERVICE;**281**;Sep 27, 1994

 +3       ; Reference to ^ORD(101 supported by IA #872

 +4       ;USED TO PRINT REPORT OR SPREADSHEET 

 +5        DO NOW^%DTC

 +6       ;Set LRLRDT- local report date time=now

           SET LRLRDT=%

 +7        SET LRRTYPE=1

           SET LRPROT=0

 +8        SET LRPROT=$ORDER(^ORD(101,"B","LREPI",LRPROT))

 +9        WRITE @IOF,?(IOM/2-15),"Laboratory Generate Local Report/Spreadsheet option"

CRI        KILL LRCYCLE,LREPI

           SET LRMSG="Pathogens"

           DO ALL

           IF $DATA(DIRUT)

               GOTO EXIT

 +1        KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT

 +2        IF +LRALL

               DO PICKALL

               GOTO DATE

 +3        SET LRMSG="Local Pathogens"

           DO ALL

           IF $DATA(DIRUT)

               GOTO CRI

 +4        KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT

 +5        IF +LRALL

               DO LOCALL

               GOTO DATE

 +6        IF +LRALL'>0

               Begin DoDot:1

 +7                WRITE @IOF

 +8                FOR 

                       IF $DATA(DIRUT)

                           QUIT 

                       Begin DoDot:2

 +9                        SET DIR(0)="PAO^69.5:EMZ"

                           SET DIR("A")="Select Pathogens: "

 +10                       SET DIR("S")="D CHKL^LREPIRM I LROK I $P(^(0),U,7)=LRPROT"

 +11                       DO ^DIR

 +12                       IF $DATA(DIRUT)

                               QUIT 

 +13                       SET LREPI(+Y)=""

                       End DoDot:2

               End DoDot:1

 +14       IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)

               GOTO CRI

 +15       IF '$DATA(LREPI)

               WRITE !,"Sorry No Pathogens Selected"

               GOTO EXIT

DATE      ;Select Search Date

 +1        KILL DIR,DIRUT

 +2        SET DIR("A")="Select Start Date: "

 +3        SET DIR(0)="DOA^:"_DT

           DO ^DIR

 +4        IF $DATA(DIRUT)

               GOTO CRI

 +5        SET LRRPS=Y

 +6        KILL DIR,DIRUT

 +7        SET DIR("A")="Select End Date: "

 +8        SET DIR(0)="DOA^:"_DT

           DO ^DIR

 +9        IF $DATA(DIRUT)

               GOTO DATE

 +10       SET LRRPE=Y

RORS      ;REPORT OR SPREADSHEET

 +1        KILL DIR,DIRUT

 +2        SET DIR(0)="SO^1:REPORT;2:SPREADSHEET"

 +3        DO ^DIR

 +4        IF $DATA(DIRUT)

               GOTO DATE

 +5        SET LRREP=Y

 +6        WRITE !!

 +7        IF LRREP=1

               IF $DATA(^XTMP("LREPILOCALREP"_LRLRDT))

                   Begin DoDot:1

 +8                    WRITE !,"Data already exists for this date and time.  Please try again later."

                   End DoDot:1

                   GOTO EXIT

 +9        IF LRREP=2

               IF $DATA(^XTMP("LREPILOCALSPSHT"_LRLRDT))

                   Begin DoDot:1

 +10                   WRITE !,"Data already exists for this date and time.  Please try again later."

                   End DoDot:1

                   GOTO EXIT

 +11       DO SEG

           IF $DATA(DIRUT)

               GOTO RORS

TITLE      KILL DIR,DIRUT

 +1        SET DIR(0)="F^3:30"

           SET DIR("A")="DOCUMENT TITLE"

 +2        DO ^DIR

 +3        IF $DATA(DIRUT)

               GOTO RORS

 +4        SET ^XTMP("LREPI"_$SELECT(LRREP=1:"LOCALREP",1:"LOCALSPSHT")_LRLRDT,"TITLE")=Y

 +5        DO TASK

           DO HOME^%ZIS

EXIT      ;

 +1        KILL D0,J,LRALL,LRAUTO,LRBEG,LRCYCLE,LRDT,LREND,LREPI,LRMSG,LROK,LROVR

 +2        KILL LRDUZ,LRRNDT,LRRPE,LRREP,LRRPS,LRRTYPE,LRY,ZTSAVE

 +3        KILL ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT

 +4        KILL LRLC,LRHDG,LRPROT,LRLRDT

 +5        KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LRSEG

 +6        KILL ^TMP($JOB)

 +7        QUIT 

 +8       ;

TASK      ;LETS TASK THIS JOB

 +1        IF '$DATA(LREPI)

               QUIT 

 +2        WRITE !!

 +3        SET LRDUZ=DUZ

 +4        KILL ZTSAVE

 +5        SET ZTSAVE("LRRTYPE")=""

           IF LRRTYPE=0

               SET ZTDTH=DT

 +6        SET ZTSAVE("LR*")=""

 +7        SET ZTIO=""

           SET ZTRTN="EN^LREPI"

           SET ZTDESC="Laboratory EPI local spreadsheet/report-generate"

 +8        DO ^%ZTLOAD

 +9        IF '$DATA(ZTQUEUED)&($DATA(ZTSK))

               WRITE @IOF,!!,"The Task has been queued",!,"Task # ",$GET(ZTSK)

               HANG 5

 +10       QUIT 

PICKALL   ;SELECT ALL ASSOCIATED PARAMETERS

 +1        SET Y=0

           FOR 

               SET Y=$ORDER(^LAB(69.5,Y))

               IF +Y'>0

                   QUIT 

               DO CHK

               IF LROK

                   SET LREPI(Y)=""

 +2        QUIT 

LOCALL    ;SELECT ALL LOCAL PATHOGENS

 +1        SET Y=99

           FOR 

               SET Y=$ORDER(^LAB(69.5,Y))

               IF Y'>0

                   QUIT 

               DO CHK

               IF LROK

                   SET LREPI(Y)=""

 +2        QUIT 

CHK       ;CHECK TO SEE IF ITS OK

 +1        IF '$DATA(LRCYCLE)

               SET LRCYCLE=$PIECE(^LAB(69.5,Y,0),U,5)

 +2        SET LROK=1

 +3        IF ($PIECE(^LAB(69.5,Y,0),U,2)="1")

               SET LROK=0

           QUIT 

 +4        IF $PIECE(^LAB(69.5,Y,0),U,7)=""

               SET LROK=0

           QUIT 

 +5        IF '$DATA(^ORD(101,$PIECE(^LAB(69.5,Y,0),U,7),0))

               SET LROK=0

           QUIT 

 +6        IF $PIECE(^LAB(69.5,Y,0),U,5)=LRCYCLE

               SET LROK=0

           QUIT 

 +7        QUIT 

ALL        KILL DIR,DIRUT

 +1        SET DIR(0)="Y"

           SET DIR("B")="NO"

           SET DIR("A")="Include All "_LRMSG

 +2        SET DIR("?")="Enter (Y)es or return to individually select pathogens."

 +3        DO ^DIR

 +4        SET LRALL=+Y

 +5        QUIT 

SEG       ;CHOOSE SEGMENTS FOR SPREADSHEET

 +1        WRITE !,"Choose the segments to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +2        WRITE !,"1-PID"

 +3        WRITE !,"2-PV1"

 +4        WRITE !,"3-DG1"

 +5        WRITE !,"4-NTE"

 +6        WRITE !,"5-OBR"

 +7        WRITE !,"6-OBX"

 +8        KILL DIR,DIRUT

 +9        SET DIR(0)="L^1:6"

 +10       DO ^DIR

 +11       IF $DATA(DIRUT)

               QUIT 

 +12       SET LRY=Y

 +13       IF LRY[1

               SET LRSEG("PID")=1

               Begin DoDot:1

 +14               WRITE !!

 +15               WRITE !,"Choose the fields from the PID segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +16               WRITE !,"1-Set Id"

 +17               WRITE !,"2-SSN"

 +18               WRITE !,"3-MPI"

 +19               WRITE !,"4-Patient Name"

 +20               WRITE !,"5-Date of Birth"

 +21               WRITE !,"6-Sex"

 +22               WRITE !,"7-Race"

 +23               WRITE !,"8-Homeless"

 +24               WRITE !,"9-State"

 +25               WRITE !,"10-Zip Code"

 +26               WRITE !,"11-County"

 +27               WRITE !,"12-Ethnicity"

 +28               WRITE !,"13-Period of Service"

 +29               KILL DIR,DIRUT

 +30               SET DIR(0)="L^1:13"

 +31               DO ^DIR

 +32               IF $DATA(DIRUT)

                       QUIT 

 +33               FOR I=1:1:13

                       IF Y[I

                           SET LRSEG("PID",I)=""

               End DoDot:1

 +34       IF LRY[2

               SET LRSEG("PV1")=1

               Begin DoDot:1

 +35               WRITE !,"Choose the fields from the PV1 segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +36               WRITE !,"1-Set Id"

 +37               WRITE !,"2-Patient Class"

 +38               WRITE !,"3-Hospital Location"

 +39               WRITE !,"4-Discharge Disposition"

 +40               WRITE !,"5-Facility"

 +41               WRITE !,"6-Admit Date/Time"

 +42               WRITE !,"7-Discharge Date/Time"

 +43               KILL DIR,DIRUT

 +44               SET DIR(0)="L^1:7"

 +45               DO ^DIR

 +46               IF $DATA(DIRUT)

                       QUIT 

 +47               FOR I=1:1:7

                       IF Y[I

                           SET LRSEG("PV1",I)=""

               End DoDot:1

 +48       IF LRY[3

               SET LRSEG("DG1")=1

               Begin DoDot:1

 +49               WRITE !,"Choose the fields from the DG1 segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +50               WRITE !,"1-Set Id"

 +51               WRITE !,"2-Diagnosis Code"

 +52               WRITE !,"3-Diagnosis"

 +53               WRITE !,"4-Admission Date"

 +54               KILL DIR,DIRUT

 +55               SET DIR(0)="L^1:4"

 +56               DO ^DIR

 +57               IF $DATA(DIRUT)

                       QUIT 

 +58               FOR I=1:1:4

                       IF Y[I

                           SET LRSEG("DG1",I)=""

               End DoDot:1

 +59       IF LRY[4

               SET LRSEG("NTE")=1

               Begin DoDot:1

 +60               WRITE !,"Choose the fields from the NTE segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +61               WRITE !,"1-Set Id"

 +62               WRITE !,"2-Comment"

 +63               KILL DIR,DIRUT

 +64               SET DIR(0)="L^1:2"

 +65               DO ^DIR

 +66               IF $DATA(DIRUT)

                       QUIT 

 +67               FOR I=1:1:2

                       IF Y[I

                           SET LRSEG("NTE",I)=""

               End DoDot:1

 +68       IF LRY[5

               SET LRSEG("OBR")=1

               Begin DoDot:1

 +69               WRITE !,"Choose the fields from the OBR segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +70               WRITE !,"1-Set Id"

 +71               WRITE !,"2-Test Name"

 +72               WRITE !,"3-Accession Date"

 +73               WRITE !,"4-Specimen"

 +74               WRITE !,"5-Accession Number"

 +75               KILL DIR,DIRUT

 +76               SET DIR(0)="L^1:5"

 +77               DO ^DIR

 +78               IF $DATA(DIRUT)

                       QUIT 

 +79               FOR I=1:1:5

                       IF Y[I

                           SET LRSEG("OBR",I)=""

               End DoDot:1

 +80       IF LRY[6

               SET LRSEG("OBX")=1

               Begin DoDot:1

 +81               WRITE !,"Choose the fields from the OBX segment to capture for ",$SELECT(LRREP=1:"report.",1:"spreadsheet.")

 +82               WRITE !,"1-Set Id"

 +83               WRITE !,"2-Value Type"

 +84               WRITE !,"3-Test Name"

 +85               WRITE !,"4-LOINC Code"

 +86               WRITE !,"5-LOINC Name"

 +87               WRITE !,"6-Test Result"

 +88               WRITE !,"7-Units"

 +89               WRITE !,"8-Abnormal Flags"

 +90               WRITE !,"9-Verified Date/Time"

 +91               KILL DIR,DIRUT

 +92               SET DIR(0)="L^1:9"

 +93               DO ^DIR

 +94               IF $DATA(DIRUT)

                       QUIT 

 +95               FOR I=1:1:10

                       IF Y[I

                           SET LRSEG("OBX",I)=""

               End DoDot:1

 +96       QUIT