source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRCAPR1A.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
RevLine 
[613]1LRCAPR1A ;DALISC/PAC/FHS/JBM - WKLD REP GENERATOR-SELECT ;10/15/92 11:15
2 ;;5.2;LAB SERVICE;**88,201**;Sep 27, 1994
3ACCN ;
4 K DIC S DIC=68,DIC(0)="AEMQZ" D ^DIC Q:Y=-1 S LRX=$P(Y,U,2),LRAA=+Y Q
5DATE ;
6 K LRSDT,LREDT
7 D ^LRWU3 Q:$G(LREND) S LRSDT=(LRSDT-.5),LREDT=$S(LREDT'=1000000:LREDT,1:DT)
8 S LRFRV=+LRSDT,LRFR=$P(+LRSDT,".") S LRTOD=$$FMTE^XLFDT(LRSDT,"1D")
9 S LRTOV=+LREDT,LRTO=$P(+LREDT,".") S LRFRD=$$FMTE^XLFDT(LREDT,"1D")
10 S LRDTH="From: "_LRFRD_" --- To: "_LRTOD
11 Q
12SPEC ;
13 K DIC S DIC="^LAB(61,"
14 S DIC(0)="AEMQ",DIC("A")="Topography or Specimen : ALL/ "
15 F I=1:1 D ^DIC Q:Y=-1 S LRSP(+Y)=+Y,DIC("A")=" Select another specimen: ",LRSP=I
16 Q
17COLL ;
18 K DIC S DIC="^LAB(62,",DIC(0)="AEMQ"
19 F I=1:1 D ^DIC Q:Y=-1 S DIC("A")="Select another Collection Sample: ",LRCOL(+Y)=+Y,LRCOL=I
20 Q
21TEST ;
22 K DIC S DIC="^LAB(60,",DIC(0)="AEMQ"
23 S DIC("A")="Select LABORATORY TEST: All//"
24 F I=1:1 D ^DIC Q:Y=-1 S LRTSTS(+Y)=$P(Y,U),LRTSTS=I,DIC("A")=" Select another LAB test: "
25 Q
26CAP ;
27 K DIC S DIC="^LAM(",DIC(0)="AEMQ",DIC("A")="Select WKLD CODES: All//"
28 F I=1:1 D ^DIC Q:Y=-1 S LRCAPS(+Y)=$P(^(0),U,2),LRCAPS=I,DIC("A")="Select another WKLD code:"
29 Q
30INSTR ;
31 K DIC S DIC=64.2
32 S DIC(0)="AEMQ",DIC("A")="Select INSTRUMENT or WKLD SUFFIX CODE: All//"
33 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 "
34 Q
35STAT ;
36 K DIC S DIC=62.05,DIC(0)="AEMQ"
37 S DIC("A")="Select URGENCY to be counted as STAT: ",DIC("B")="STAT"
38 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")
39 Q:'$D(LRSTAT) K DIC,DUOUT
40 S %=2 W !!,"Do you want to look up only tests with a STAT urgency"
41 S LRSTAT=0 D YN^DICN S:%=1 LRSTAT=1
42 Q
43LOC ;
44 K DIC S DIC="^SC(",DIC(0)="AEMQ",DIC("A")="Select LOCATION NAME: All//"
45 F I=1:1 D ^DIC Q:Y=-1 S LRLOC(+Y)=$P(^(0),U),DIC("A")="Select another location: ",LRLOC=I
46 Q
47IOPAT ;
48 K DIR,Y S DIR(0)="SB^I:INPATIENTS;O:OUTPATIENTS;R:OTHER;A:ALL"
49 S DIR("B")="ALL",DIR("A")="Select Patient Type: "
50 S DIR("?")="-------------------------"
51 S DIR("?",1)="The codes are as follows:"
52 S DIR("?",2)="-------------------------"
53 S DIR("?",3)=" I - INPATIENTS "
54 S DIR("?",4)=" O - OUTPATIENTS "
55 S DIR("?",5)=" R - OTHER PATIENTS "
56 S DIR("?",6)=" A - ALL OF THE ABOVE"
57 F D ^DIR D Q:($D(DUOUT))!($D(DTOUT))!(X="")
58 . Q:($D(DUOUT))!($D(DTOUT))!(X="")
59 . I Y="A" S LRIOPAT="IORA",X="" Q
60 . S LRIOPAT=$S('$D(LRIOPAT):Y,LRIOPAT[Y:LRIOPAT,1:LRIOPAT_Y)
61 . I (LRIOPAT["I")&(LRIOPAT["O")&(LRIOPAT["R") S LRIOPAT="IORA",DUOUT=1 Q
62 . K DIR("B")
63 . S DIR("A")="Select another Patient Type: "
64 . S $P(DIR(0),U)="SBO"
65 Q
66CONTROL ;
67 S %=2
68 W !!,"Do you want to see a break out of controls for the condensed"
69 W " section:",!,"TESTS by INSTRUMENTS"
70 S LRCTL=0
71 D YN^DICN
72 I %=0 W !!,"Enter YES if you want this extra section printed, NO if you don't." G CONTROL
73 I %<0 S LREND=1 Q
74 S:%=1 LRCTL=1
75 Q
76REPTYP ;
77 K DIR
78 S DIR(0)="S^1:All workload;2:LMIP reportable workload;3:Non-LMIP workload"
79 S DIR("A")="Enter the number for the workload data to report"
80 S DIR("B")=1
81 S DIR("?")=" reportable for LMIP."
82 S DIR("?",1)="1 - will include all workload data in the file, period."
83 S DIR("?",2)=" "
84 S DIR("?",3)="2 - will include only workload which is associated with a"
85 S DIR("?",4)=" WKLD code that is marked as reportable for LMIP uses."
86 S DIR("?",5)=" "
87 S DIR("?",6)="3 - will include any workload which is not marked as"
88 D ^DIR
89 I ($D(DTOUT))!($D(DUOUT)) S LREND=1 Q
90 S LRRTYP=Y
91 Q
Note: See TracBrowser for help on using the repository browser.