LRARC1A ; IHS/DIR/AAB - CLONED WKLD REP GENERATOR-SELECT FOR ARCHIVING ; [ 5/8/95 ]
;;5.2;LR;**1002**;JUN 01, 1998
;;5.2;LAB SERVICE;**59**;August 31, 1995
;same as LRCAP1A except for archived wkld file reference
ACCN ;
K DIC S DIC=68,DIC(0)="AEMQZ" D ^DIC Q:Y=-1 S LRX=$P(Y,U,2),LRAA=+Y Q
DATE ;
K LRSDT,LREDT
D ^LRWU3 Q:$G(LREND) S LRSDT=(LRSDT-.5),LREDT=$S(LREDT'=1000000:LREDT,1:DT)
S LRFRV=+LRSDT,LRFR=$P(+LRSDT,".") S LRFRD=$$DTF^LRAFUNC1(LRSDT)
S LRTOV=+LREDT,LRTO=$P(+LREDT,".") S LRTOD=$$DTF^LRAFUNC1(LREDT)
S LRDTH="From: "_LRFRD_" --- To: "_LRTOD
Q
SPEC ;
K DIC S DIC="^LAB(61,"
S DIC(0)="AEMQ",DIC("A")="Topography or Specimen : ALL/ "
F I=1:1 D ^DIC Q:Y=-1 S LRSP(+Y)=+Y,DIC("A")=" Select another specimen: ",LRSP=I
Q
COLL ;
K DIC S DIC="^LAB(62,",DIC(0)="AEMQ"
F I=1:1 D ^DIC Q:Y=-1 S DIC("A")="Select another Collection Sample: ",LRCOL(+Y)=+Y,LRCOL=I
Q
TEST ;
K DIC S DIC="^LAB(60,",DIC(0)="AEMQ"
S DIC("A")="Select LABORATORY TEST: All//"
F I=1:1 D ^DIC Q:Y=-1 S LRTSTS(+Y)=$P(Y,U),LRTSTS=I,DIC("A")=" Select another LAB test: "
Q
CAP ;
K DIC S DIC="^LAM(",DIC(0)="AEMQ",DIC("A")="Select WKLD CODES: All//"
F I=1:1 D ^DIC Q:Y=-1 S LRCAPS(+Y)=$P(^(0),U,2),LRCAPS=I,DIC("A")="Select another WKLD code:"
Q
INSTR ;
K DIC S DIC=64.2
S DIC(0)="AEMQ",DIC("A")="Select INSTRUMENT or WKLD SUFFIX CODE: All//"
F I=1:1 D ^DIC Q:Y=-1 S LRCPSX($P(^LAB(64.2,+Y,0),U,2))=+Y,LRCPSX=I,DIC("A")="Select another "
Q
STAT ;
K DIC S DIC=62.05,DIC(0)="AEMQ"
S DIC("A")="Select URGENCY to be counted as STAT: ",DIC("B")="STAT"
F I=1:1 D ^DIC Q:Y=-1 S LRSTAT(+Y)=$P(Y,U,2),LRSTAT(50+Y)=$P($G(^LAB(62.05,(50+Y),0)),U),DIC("A")="Select another: " K DIC("B")
Q:'$D(LRSTAT) K DIC,DUOUT
S %=2 W !!,"Do you want to look up only tests with a STAT urgency"
S LRSTAT=0 D YN^DICN S:%=1 LRSTAT=1
Q
LOC ;
K DIC S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select LOCATION NAME: All//"
F I=1:1 D ^DIC Q:Y=-1 S LRLOC(+Y)=$P(^(0),U),DIC("A")="Select another location: ",LRLOC=I
Q
IOPAT ;
K DIR,Y S DIR(0)="SB^I:INPATIENTS;O:OUTPATIENTS;R:OTHER;A:ALL"
S DIR("B")="ALL",DIR("A")="Select Patient Type: "
S DIR("?")="-------------------------"
S DIR("?",1)="The codes are as follows:"
S DIR("?",2)="-------------------------"
S DIR("?",3)=" I - INPATIENTS "
S DIR("?",4)=" O - OUTPATIENTS "
S DIR("?",5)=" R - OTHER PATIENTS "
S DIR("?",6)=" A - ALL OF THE ABOVE"
F D ^DIR D Q:($D(DUOUT))!($D(DTOUT))!(X="")
. Q:($D(DUOUT))!($D(DTOUT))!(X="")
. I Y="A" S LRIOPAT="IORA",X="" Q
. S LRIOPAT=$S('$D(LRIOPAT):Y,LRIOPAT[Y:LRIOPAT,1:LRIOPAT_Y)
. I (LRIOPAT["I")&(LRIOPAT["O")&(LRIOPAT["R") S LRIOPAT="IORA",DUOUT=1 Q
. K DIR("B")
. S DIR("A")="Select another Patient Type: "
. S $P(DIR(0),U)="SBO"
Q
CONTROL ;
S %=2
W !!,"Do you want to see a break out of controls for the condensed"
W " section:",!,"TESTS by INSTRUMENTS"
S LRCTL=0
D YN^DICN
I %=0 W !!,"Enter YES if you want this extra section printed, NO if you don't." G CONTROL
I %<0 S LREND=1 Q
S:%=1 LRCTL=1
Q
REPTYP ;
K DIR
S DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
S DIR("A")="Enter the number for the workload data to report"
S DIR("B")=1
S DIR("?")=" reportable for LMIP."
S DIR("?",1)="1 - will include all workload data in the file, period."
S DIR("?",2)=" "
S DIR("?",3)="2 - will include only workload which is associated with a"
S DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
S DIR("?",5)=" "
S DIR("?",6)="3 - will include any workload which is not marked as"
D ^DIR
I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
S LRRTYP=Y
Q
LRARC1A ; IHS/DIR/AAB - CLONED WKLD REP GENERATOR-SELECT FOR ARCHIVING ; [ 5/8/95 ]
+1 ;;5.2;LR;**1002**;JUN 01, 1998
+2 ;;5.2;LAB SERVICE;**59**;August 31, 1995
+3 ;same as LRCAP1A except for archived wkld file reference
ACCN ;
+1 KILL DIC
SET DIC=68
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y=-1
QUIT
SET LRX=$PIECE(Y,U,2)
SET LRAA=+Y
QUIT
DATE ;
+1 KILL LRSDT,LREDT
+2 DO ^LRWU3
IF $GET(LREND)
QUIT
SET LRSDT=(LRSDT-.5)
SET LREDT=$SELECT(LREDT'=1000000:LREDT,1:DT)
+3 SET LRFRV=+LRSDT
SET LRFR=$PIECE(+LRSDT,".")
SET LRFRD=$$DTF^LRAFUNC1(LRSDT)
+4 SET LRTOV=+LREDT
SET LRTO=$PIECE(+LREDT,".")
SET LRTOD=$$DTF^LRAFUNC1(LREDT)
+5 SET LRDTH="From: "_LRFRD_" --- To: "_LRTOD
+6 QUIT
SPEC ;
+1 KILL DIC
SET DIC="^LAB(61,"
+2 SET DIC(0)="AEMQ"
SET DIC("A")="Topography or Specimen : ALL/ "
+3 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRSP(+Y)=+Y
SET DIC("A")=" Select another specimen: "
SET LRSP=I
+4 QUIT
COLL ;
+1 KILL DIC
SET DIC="^LAB(62,"
SET DIC(0)="AEMQ"
+2 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET DIC("A")="Select another Collection Sample: "
SET LRCOL(+Y)=+Y
SET LRCOL=I
+3 QUIT
TEST ;
+1 KILL DIC
SET DIC="^LAB(60,"
SET DIC(0)="AEMQ"
+2 SET DIC("A")="Select LABORATORY TEST: All//"
+3 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRTSTS(+Y)=$PIECE(Y,U)
SET LRTSTS=I
SET DIC("A")=" Select another LAB test: "
+4 QUIT
CAP ;
+1 KILL DIC
SET DIC="^LAM("
SET DIC(0)="AEMQ"
SET DIC("A")="Select WKLD CODES: All//"
+2 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRCAPS(+Y)=$PIECE(^(0),U,2)
SET LRCAPS=I
SET DIC("A")="Select another WKLD code:"
+3 QUIT
INSTR ;
+1 KILL DIC
SET DIC=64.2
+2 SET DIC(0)="AEMQ"
SET DIC("A")="Select INSTRUMENT or WKLD SUFFIX CODE: All//"
+3 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRCPSX($PIECE(^LAB(64.2,+Y,0),U,2))=+Y
SET LRCPSX=I
SET DIC("A")="Select another "
+4 QUIT
STAT ;
+1 KILL DIC
SET DIC=62.05
SET DIC(0)="AEMQ"
+2 SET DIC("A")="Select URGENCY to be counted as STAT: "
SET DIC("B")="STAT"
+3 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRSTAT(+Y)=$PIECE(Y,U,2)
SET LRSTAT(50+Y)=$PIECE($GET(^LAB(62.05,(50+Y),0)),U)
SET DIC("A")="Select another: "
KILL DIC("B")
+4 IF '$DATA(LRSTAT)
QUIT
KILL DIC,DUOUT
+5 SET %=2
WRITE !!,"Do you want to look up only tests with a STAT urgency"
+6 SET LRSTAT=0
DO YN^DICN
IF %=1
SET LRSTAT=1
+7 QUIT
LOC ;
+1 KILL DIC
SET DIC="^SC("
SET DIC(0)="AEMQ"
SET DIC("A")="Select LOCATION NAME: All//"
+2 FOR I=1:1
DO ^DIC
IF Y=-1
QUIT
SET LRLOC(+Y)=$PIECE(^(0),U)
SET DIC("A")="Select another location: "
SET LRLOC=I
+3 QUIT
IOPAT ;
+1 KILL DIR,Y
SET DIR(0)="SB^I:INPATIENTS;O:OUTPATIENTS;R:OTHER;A:ALL"
+2 SET DIR("B")="ALL"
SET DIR("A")="Select Patient Type: "
+3 SET DIR("?")="-------------------------"
+4 SET DIR("?",1)="The codes are as follows:"
+5 SET DIR("?",2)="-------------------------"
+6 SET DIR("?",3)=" I - INPATIENTS "
+7 SET DIR("?",4)=" O - OUTPATIENTS "
+8 SET DIR("?",5)=" R - OTHER PATIENTS "
+9 SET DIR("?",6)=" A - ALL OF THE ABOVE"
+10 FOR
DO ^DIR
Begin DoDot:1
+11 IF ($DATA(DUOUT))!($DATA(DTOUT))!(X="")
QUIT
+12 IF Y="A"
SET LRIOPAT="IORA"
SET X=""
QUIT
+13 SET LRIOPAT=$SELECT('$DATA(LRIOPAT):Y,LRIOPAT[Y:LRIOPAT,1:LRIOPAT_Y)
+14 IF (LRIOPAT["I")&(LRIOPAT["O")&(LRIOPAT["R")
SET LRIOPAT="IORA"
SET DUOUT=1
QUIT
+15 KILL DIR("B")
+16 SET DIR("A")="Select another Patient Type: "
+17 SET $PIECE(DIR(0),U)="SBO"
End DoDot:1
IF ($DATA(DUOUT))!($DATA(DTOUT))!(X="")
QUIT
+18 QUIT
CONTROL ;
+1 SET %=2
+2 WRITE !!,"Do you want to see a break out of controls for the condensed"
+3 WRITE " section:",!,"TESTS by INSTRUMENTS"
+4 SET LRCTL=0
+5 DO YN^DICN
+6 IF %=0
WRITE !!,"Enter YES if you want this extra section printed, NO if you don't."
GOTO CONTROL
+7 IF %<0
SET LREND=1
QUIT
+8 IF %=1
SET LRCTL=1
+9 QUIT
REPTYP ;
+1 KILL DIR
+2 SET DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
+3 SET DIR("A")="Enter the number for the workload data to report"
+4 SET DIR("B")=1
+5 SET DIR("?")=" reportable for LMIP."
+6 SET DIR("?",1)="1 - will include all workload data in the file, period."
+7 SET DIR("?",2)=" "
+8 SET DIR("?",3)="2 - will include only workload which is associated with a"
+9 SET DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
+10 SET DIR("?",5)=" "
+11 SET DIR("?",6)="3 - will include any workload which is not marked as"
+12 DO ^DIR
+13 IF ($DATA(DTOUT))!($DATA(DUOUT))
SET LREND=1
QUIT
+14 SET LRRTYP=Y
+15 QUIT
