LRMITSE.m

LRMITSE ;VA/SLC/STAFF - MICRO TREND ENTRY ;JUL 06, 2010 3:14 PM

 ;;5.2;LAB SERVICE;**96,257,1027**;NOV 01, 1997

 ; from LRMITS

 ; collect input data for trend report

 ; LRAP(drug node)=organism #  if antibiotic pattern defined

 ; LRDETAIL  detailed report with patient results

 ; LREND  flag to end program

 ; LRHELP  help frame

 ; LRLOS  length of stay

 ; LRMERGE  none/spec/col sample/any  "N"/"S"/"C"/"A"

 ; LRM(type of report,"A")="" all values

 ; LRM(type of report,"S",value #)=value name  selected values

 ; LROTYPE(type of organism)=""  organism types  "B"/"F"/"M"/"P"/"V"

 ; LRSORG(type of organism,organism #)=""  if specific organisms selected

 ; LRSORT Defines antibiotic reporting order by alph or print order

 ; LRSUSR(interp)=""  interpretations forced to 'R'

 ; LRSUSS(interp)=""  interpretations forced to 'S'

 ; LRUNK  "Unknown" - used for any value

 ; LRTBEG  begin time

 ; LRTEND  end time

 ;

 W @IOF,?30,"MICROBIOLOGY TREND REPORT",!

 ; initialize variables and defaults

 K LRAP,LRM,LROTYPE,LRSORG,LRSUSR,LRSUSS

DIV ;MULTIDIVISIONAL PATCH LR*5.2*257 - 3/01

 ;ASK IF WANT REPORT BY DIVISION

 S LRASK="DIV",LRHELP="LRMITS OPTION"

 W !!,"Report by: DIVISION"

 S LRPX=$S($D(LRM(LRASK,"A")):"All",1:"No") K DIC,DIR,LRM(LRASK)

 S DIR(0)="SAM^A:All;S:Selected;N:No",DIR("A")="(A)ll Divisions, (S)elected Divisions, or (N)o Division Report? ",DIR("B")=LRPX

 S DIR("?")="Enter 'A'll, 'S'elected, or 'N'o.",DIR("??")=LRHELP

 S DIR("?",1)="Select 'A' to obtain a report grouped by all divisions."

 S DIR("?",2)="Select 'S' to obtain a report grouped for selected divisions."

 S DIR("?",3)="Select 'N' if you DO NOT want a report grouped by division."

 S DIR("?",4)="Enter '^' to exit."

 D ^DIR I $D(DIRUT) S LREND=1 Q

 I Y="A" S LRM(LRASK,"A")=""

 ; if specific values are requested, obtain selections

 I Y="S" D

 .S DIC=4,DIC(0)="AEMOQ",DIC("A")="Select Division: " F  D ^DIC Q:Y<1  S LRM(LRASK,"S",+Y)=$P(Y,U,2),LRSDIV=+Y

 K DIC I $D(DTOUT) S LREND=1

 ;

 S LRDETAIL=0,LRHELP="LRMITS OPTION",LRLOS=0,LRMERGE="S",LROTYPE("B")="",LRUNK="Unknown"

 S (LRSUSR("I"),LRSUSR("R"),LRSUSS("MS"),LRSUSS("S"))=""

 S OK=1

 S LRBLIK=""

 D FILSCAN ;<------DRH patch 96

 Q:'OK

 I $D(^TMP("LRM",$J)) D QUERY

 F LRX="O","S","L","D","P","C" I $D(^LAB(69.9,1,"MIT","B",LRX)) S LRM(LRX,"A")=""

 ; default reports

 I 'OK S LREND=1 QUIT

SORT K DIR S DIR(0)="SAMO^A:Alphabetically;P:Print Order",DIR("B")="A"

 S DIR("A")="Sort the Antibiotic output by: "

 S DIR("?")="Enter 'A'lphabetically or 'P'rint Order"

 S DIR("?",1)="This allows you to choose how the Antibiotics will be"

 S DIR("?",2)="sorted. Alphabetically will sort by the mnemonics and "

 S DIR("?",3)="Print Order will use the order defined in file #62.06"

 S DIR("?",4)="ANTIMICROBIAL SUSCEPTIBILITY" D ^DIR I $D(DIRUT) S LREND=1 Q

 S LRSORT=$S(Y="P":1,1:0)

 ;

 K DIR S DIR(0)="Y",DIR("A")="Use default reports HERE",DIR("B")="YES"

 S DIR("?")="Enter 'Y'es or 'N'o",DIR("??")=LRHELP

 S DIR("?",1)="Default reports are setup in the Laboratory Site file, 69.9."

 S DIR("?",2)="If you answer 'NO', you can select individual antibiotic trend reports"

 S DIR("?",3)="grouped by: organism, site/specimen, location, patient, physician, and/or"

 S DIR("?",4)="collection sample.  You can select all items or a single item for each group."

 S DIR("?",5)="Example: a trend report on a single patient."

 D ^DIR I $D(DIRUT) G SORT

 K DIR,LRX

 ; get specific input if not using default data

 I 'Y D ^LRMITSEC Q:LREND  D ^LRMITSES Q:LREND

 ; if no reports selected quit

 I '$D(LRM) W !,"No reports were selected!" S LREND=1 Q

 ; get date range

 W ! K DIR S DIR(0)="D^::AE",DIR("A")="Start Date"

 S DIR("?")="^D HELP^%DTC",DIR("??")=LRHELP

 D ^DIR I $D(DIRUT) S LREND=1 Q

 S LRTBEG=Y\1 ;S LRTBEG=$E(Y,1,5)_"00"

 K DIR S DIR(0)="D^::AE",DIR("A")="End Date"

 S DIR("?")="^D HELP^%DTC",DIR("??")=LRHELP

 D ^DIR I $D(DIRUT) S LREND=1 Q

 S LRTEND=Y\1 ;S LRTEND=$E(Y,1,5)_"00"

 I LRTEND<LRTBEG S X=LRTBEG,LRTBEG=LRTEND,LRTEND=X

 W ! K DIR,LRHELP,X,Y

 Q

 ;-------------------LR*5.2*96------------------------------------

FILSCAN ; scan ^LAB(62.06 FOR non std DEFAULT INTERPS ie RES, SUS etc  <--

 K ^TMP("LRM",$J)

 S LRSCN("R")="R",LRSCN("MS")="MS",LRSCN("I")="I",LRSCN("S")="S"

 S LRTIC=0,LRCNT=1

 F  S LRTIC=$O(^LAB(62.06,LRTIC)) Q:+LRTIC'>0  D

 .  S LRCN=0

 .  F  S LRCN=$O(^LAB(62.06,LRTIC,1,LRCN)) Q:+LRCN'>0  S NODE=^(LRCN,0) D

 ..  S NODE=$P(NODE,U,2) Q:NODE?1P.E!(+NODE'=0)  I 'NODE D MISSNG

 ..  F LRTAC="I","S","R","MS" S:LRTAC=NODE LRGOT1=1

 ..  Q:NODE=""  I $G(LRGOT1)'=1 S ^TMP("LRM",$J,NODE)="" S LRCNT=LRCNT+1

 ..  K LRGOT1

 K NODE,LRCN,LRSCN,LRTIC,LRTAC

 Q

MISSNG ;

 Q:$G(LRBLIK)=1

 ;W !!,"You have required fields without data. Please check file 62.06 for deletions.",$C(7)

 ;Commented out for future use

 S LRBLIK=1

 Q

QUERY ; Present to user non std entries from ^TMP classify per std.

 ; LRSUSR(interp)=""  interpretations forced to 'R'

 ; LRSUSS(interp)=""  interpretations forced to 'S'

 W !!,"I scanned your Antimicrobial Susceptibility File and was"

 W !,"surprised to see you have non-standard entries in the default"

 W !,"interpretation field."

 W !!,"In order for me to proceed, I need to know what the entry means."

 K DIR

 S DIR(0)="SOM^1:RESISTANT;2:SUSCEPTIBLE"

 S DIR("A")="Please enter your response here"

 S LRNTRP="",OK=1

 F  S LRNTRP=$O(^TMP("LRM",$J,LRNTRP)) Q:LRNTRP=""!'OK  W !!!,?32,"*****",LRNTRP,"*****" D

 .  Q:'$D(LRNTRP)  D ^DIR

 .  S:$D(DIRUT) OK="" I 'OK QUIT

 .  I Y=1 S LRSUSR(LRNTRP)=""

 .  E  S LRSUSS(LRNTRP)=""

 K ^TMP("LRM")

 K LRNTRP

 ;---------------------------------------------------------------------

 Q

LRMITSE   ;VA/SLC/STAFF - MICRO TREND ENTRY ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;LAB SERVICE;**96,257,1027**;NOV 01, 1997

 +2       ; from LRMITS

 +3       ; collect input data for trend report

 +4       ; LRAP(drug node)=organism #  if antibiotic pattern defined

 +5       ; LRDETAIL  detailed report with patient results

 +6       ; LREND  flag to end program

 +7       ; LRHELP  help frame

 +8       ; LRLOS  length of stay

 +9       ; LRMERGE  none/spec/col sample/any  "N"/"S"/"C"/"A"

 +10      ; LRM(type of report,"A")="" all values

 +11      ; LRM(type of report,"S",value #)=value name  selected values

 +12      ; LROTYPE(type of organism)=""  organism types  "B"/"F"/"M"/"P"/"V"

 +13      ; LRSORG(type of organism,organism #)=""  if specific organisms selected

 +14      ; LRSORT Defines antibiotic reporting order by alph or print order

 +15      ; LRSUSR(interp)=""  interpretations forced to 'R'

 +16      ; LRSUSS(interp)=""  interpretations forced to 'S'

 +17      ; LRUNK  "Unknown" - used for any value

 +18      ; LRTBEG  begin time

 +19      ; LRTEND  end time

 +20      ;

 +21       WRITE @IOF,?30,"MICROBIOLOGY TREND REPORT",!

 +22      ; initialize variables and defaults

 +23       KILL LRAP,LRM,LROTYPE,LRSORG,LRSUSR,LRSUSS

DIV       ;MULTIDIVISIONAL PATCH LR*5.2*257 - 3/01

 +1       ;ASK IF WANT REPORT BY DIVISION

 +2        SET LRASK="DIV"

           SET LRHELP="LRMITS OPTION"

 +3        WRITE !!,"Report by: DIVISION"

 +4        SET LRPX=$SELECT($DATA(LRM(LRASK,"A")):"All",1:"No")

           KILL DIC,DIR,LRM(LRASK)

 +5        SET DIR(0)="SAM^A:All;S:Selected;N:No"

           SET DIR("A")="(A)ll Divisions, (S)elected Divisions, or (N)o Division Report? "

           SET DIR("B")=LRPX

 +6        SET DIR("?")="Enter 'A'll, 'S'elected, or 'N'o."

           SET DIR("??")=LRHELP

 +7        SET DIR("?",1)="Select 'A' to obtain a report grouped by all divisions."

 +8        SET DIR("?",2)="Select 'S' to obtain a report grouped for selected divisions."

 +9        SET DIR("?",3)="Select 'N' if you DO NOT want a report grouped by division."

 +10       SET DIR("?",4)="Enter '^' to exit."

 +11       DO ^DIR

           IF $DATA(DIRUT)

               SET LREND=1

               QUIT 

 +12       IF Y="A"

               SET LRM(LRASK,"A")=""

 +13      ; if specific values are requested, obtain selections

 +14       IF Y="S"

               Begin DoDot:1

 +15               SET DIC=4

                   SET DIC(0)="AEMOQ"

                   SET DIC("A")="Select Division: "

                   FOR 

                       DO ^DIC

                       IF Y<1

                           QUIT 

                       SET LRM(LRASK,"S",+Y)=$PIECE(Y,U,2)

                       SET LRSDIV=+Y

               End DoDot:1

 +16       KILL DIC

           IF $DATA(DTOUT)

               SET LREND=1

 +17      ;

 +18       SET LRDETAIL=0

           SET LRHELP="LRMITS OPTION"

           SET LRLOS=0

           SET LRMERGE="S"

           SET LROTYPE("B")=""

           SET LRUNK="Unknown"

 +19       SET (LRSUSR("I"),LRSUSR("R"),LRSUSS("MS"),LRSUSS("S"))=""

 +20       SET OK=1

 +21       SET LRBLIK=""

 +22      ;<------DRH patch 96

           DO FILSCAN

 +23       IF 'OK

               QUIT 

 +24       IF $DATA(^TMP("LRM",$JOB))

               DO QUERY

 +25       FOR LRX="O","S","L","D","P","C"

               IF $DATA(^LAB(69.9,1,"MIT","B",LRX))

                   SET LRM(LRX,"A")=""

 +26      ; default reports

 +27       IF 'OK

               SET LREND=1

               QUIT 

SORT       KILL DIR

           SET DIR(0)="SAMO^A:Alphabetically;P:Print Order"

           SET DIR("B")="A"

 +1        SET DIR("A")="Sort the Antibiotic output by: "

 +2        SET DIR("?")="Enter 'A'lphabetically or 'P'rint Order"

 +3        SET DIR("?",1)="This allows you to choose how the Antibiotics will be"

 +4        SET DIR("?",2)="sorted. Alphabetically will sort by the mnemonics and "

 +5        SET DIR("?",3)="Print Order will use the order defined in file #62.06"

 +6        SET DIR("?",4)="ANTIMICROBIAL SUSCEPTIBILITY"

           DO ^DIR

           IF $DATA(DIRUT)

               SET LREND=1

               QUIT 

 +7        SET LRSORT=$SELECT(Y="P":1,1:0)

 +8       ;

 +9        KILL DIR

           SET DIR(0)="Y"

           SET DIR("A")="Use default reports HERE"

           SET DIR("B")="YES"

 +10       SET DIR("?")="Enter 'Y'es or 'N'o"

           SET DIR("??")=LRHELP

 +11       SET DIR("?",1)="Default reports are setup in the Laboratory Site file, 69.9."

 +12       SET DIR("?",2)="If you answer 'NO', you can select individual antibiotic trend reports"

 +13       SET DIR("?",3)="grouped by: organism, site/specimen, location, patient, physician, and/or"

 +14       SET DIR("?",4)="collection sample.  You can select all items or a single item for each group."

 +15       SET DIR("?",5)="Example: a trend report on a single patient."

 +16       DO ^DIR

           IF $DATA(DIRUT)

               GOTO SORT

 +17       KILL DIR,LRX

 +18      ; get specific input if not using default data

 +19       IF 'Y

               DO ^LRMITSEC

               IF LREND

                   QUIT 

               DO ^LRMITSES

               IF LREND

                   QUIT 

 +20      ; if no reports selected quit

 +21       IF '$DATA(LRM)

               WRITE !,"No reports were selected!"

               SET LREND=1

               QUIT 

 +22      ; get date range

 +23       WRITE !

           KILL DIR

           SET DIR(0)="D^::AE"

           SET DIR("A")="Start Date"

 +24       SET DIR("?")="^D HELP^%DTC"

           SET DIR("??")=LRHELP

 +25       DO ^DIR

           IF $DATA(DIRUT)

               SET LREND=1

               QUIT 

 +26      ;S LRTBEG=$E(Y,1,5)_"00"

           SET LRTBEG=Y\1

 +27       KILL DIR

           SET DIR(0)="D^::AE"

           SET DIR("A")="End Date"

 +28       SET DIR("?")="^D HELP^%DTC"

           SET DIR("??")=LRHELP

 +29       DO ^DIR

           IF $DATA(DIRUT)

               SET LREND=1

               QUIT 

 +30      ;S LRTEND=$E(Y,1,5)_"00"

           SET LRTEND=Y\1

 +31       IF LRTEND<LRTBEG

               SET X=LRTBEG

               SET LRTBEG=LRTEND

               SET LRTEND=X

 +32       WRITE !

           KILL DIR,LRHELP,X,Y

 +33       QUIT 

 +34      ;-------------------LR*5.2*96------------------------------------

FILSCAN   ; scan ^LAB(62.06 FOR non std DEFAULT INTERPS ie RES, SUS etc  <--

 +1        KILL ^TMP("LRM",$JOB)

 +2        SET LRSCN("R")="R"

           SET LRSCN("MS")="MS"

           SET LRSCN("I")="I"

           SET LRSCN("S")="S"

 +3        SET LRTIC=0

           SET LRCNT=1

 +4        FOR 

               SET LRTIC=$ORDER(^LAB(62.06,LRTIC))

               IF +LRTIC'>0

                   QUIT 

               Begin DoDot:1

 +5                SET LRCN=0

 +6                FOR 

                       SET LRCN=$ORDER(^LAB(62.06,LRTIC,1,LRCN))

                       IF +LRCN'>0

                           QUIT 

                       SET NODE=^(LRCN,0)

                       Begin DoDot:2

 +7                        SET NODE=$PIECE(NODE,U,2)

                           IF NODE?1P.E!(+NODE'=0)

                               QUIT 

                           IF 'NODE

                               DO MISSNG

 +8                        FOR LRTAC="I","S","R","MS"

                               IF LRTAC=NODE

                                   SET LRGOT1=1

 +9                        IF NODE=""

                               QUIT 

                           IF $GET(LRGOT1)'=1

                               SET ^TMP("LRM",$JOB,NODE)=""

                               SET LRCNT=LRCNT+1

 +10                       KILL LRGOT1

                       End DoDot:2

               End DoDot:1

 +11       KILL NODE,LRCN,LRSCN,LRTIC,LRTAC

 +12       QUIT 

MISSNG    ;

 +1        IF $GET(LRBLIK)=1

               QUIT 

 +2       ;W !!,"You have required fields without data. Please check file 62.06 for deletions.",$C(7)

 +3       ;Commented out for future use

 +4        SET LRBLIK=1

 +5        QUIT 

QUERY     ; Present to user non std entries from ^TMP classify per std.

 +1       ; LRSUSR(interp)=""  interpretations forced to 'R'

 +2       ; LRSUSS(interp)=""  interpretations forced to 'S'

 +3        WRITE !!,"I scanned your Antimicrobial Susceptibility File and was"

 +4        WRITE !,"surprised to see you have non-standard entries in the default"

 +5        WRITE !,"interpretation field."

 +6        WRITE !!,"In order for me to proceed, I need to know what the entry means."

 +7        KILL DIR

 +8        SET DIR(0)="SOM^1:RESISTANT;2:SUSCEPTIBLE"

 +9        SET DIR("A")="Please enter your response here"

 +10       SET LRNTRP=""

           SET OK=1

 +11       FOR 

               SET LRNTRP=$ORDER(^TMP("LRM",$JOB,LRNTRP))

               IF LRNTRP=""!'OK

                   QUIT 

               WRITE !!!,?32,"*****",LRNTRP,"*****"

               Begin DoDot:1

 +12               IF '$DATA(LRNTRP)

                       QUIT 

                   DO ^DIR

 +13               IF $DATA(DIRUT)

                       SET OK=""

                   IF 'OK

                       QUIT 

 +14               IF Y=1

                       SET LRSUSR(LRNTRP)=""

 +15              IF '$TEST

                       SET LRSUSS(LRNTRP)=""

               End DoDot:1

 +16       KILL ^TMP("LRM")

 +17       KILL LRNTRP

 +18      ;---------------------------------------------------------------------

 +19       QUIT