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
