- LRARCR1A ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-SELECT ;
- ;;5.2;LAB SERVICE;**59**;August 31, 1995
- ;same as LRCAPR1A except now references archived files
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRARCR1A 3658 printed Jan 18, 2025@03:10 Page 2
- LRARCR1A ;DALISC/CKA - ARCHIVED WKLD REP GENERATOR-SELECT ;
- +1 ;;5.2;LAB SERVICE;**59**;August 31, 1995
- +2 ;same as LRCAPR1A except now references archived files
- 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