source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRARCR2.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1LRARCR2 ;DALISC/CKA - CLONED WKLD REP GENERATOR-BUILD FOR ARCHIVING;5/8/95
2 ;;5.2;LAB SERVICE;**59**;Aug 31, 1995
3 ;same as LRCAPR2 except archived wkld file
4 S:$D(ZTQUEUED) ZTREQ="@"
5 K ^TMP("LRAR",$J) D DATE,^LRARCR3
6 Q
7DATE ;
8 I LRTO<LRFR S X=LRFR,LRFR=LRTO,LRTO=X
9 S LRST=LRFR-.000001
10 F S LRST=$O(^LRO(68,LRAA,1,LRST)) Q:'LRST!(LRST>LRTO) D
11 . S LRNT=0
12 . F S LRNT=$O(^LRO(68,LRAA,1,LRST,1,LRNT)) Q:'LRNT D ACC
13 Q
14ACC ;
15 S LRACCREC=$G(^LRO(68,LRAA,1,LRST,1,LRNT,0)) Q:LRACCREC=""
16 S LRFIL=+$P(LRACCREC,U,2) Q:'LRFIL Q:(LRFIL>67.0)&(LRFIL<67.9999)
17 S LRLTYP=$P(LRACCREC,U,11)
18 S LRPATOK=$$CHKPAT(LRIOPAT,LRLTYP,LRFIL) Q:'+LRPATOK
19 S LRPTYP=$E(LRPATOK,2)
20 S LRLC=+$P(LRACCREC,U,13) I LRLOC Q:'$D(LRLOC(LRLC))!(LRLC<1)
21 S:+LRLC LRLC=$P($G(^SC(LRLC,0)),U) S:LRLC="" LRLC="*MISSING LOC*"
22 S LRAANO=$S($D(^LRO(68,LRAA,1,LRST,1,LRNT,.2)):^(.2),1:"NO ACCN")
23 S LRSTCS=$G(^LRO(68,LRAA,1,LRST,1,LRNT,5,1,0)) Q:'LRSTCS
24 I LRSP Q:'$P(LRSTCS,U) Q:'$D(LRSP($P(LRSTCS,U)))
25 I LRCOL Q:'$P(LRSTCS,U,2) Q:'$D(LRCOL($P(LRSTCS,U,2)))
26 S LRTST=0
27 F S LRTST=$O(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST)) Q:'LRTST D TEST
28 Q
29TEST ;
30 I LRTSTS,'$D(LRTSTS(LRTST)) Q
31 Q:'$D(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST,0))#2 S LRNX=^(0) Q:'$P(LRNX,U,5)
32 S LRNX5=$P(LRNX,U,5),LRNX5D=$P(LRNX5,"."),LRURG=$P(LRNX,U,2)
33 I $G(LRSTAT) Q:LRURG="" Q:'$D(LRSTAT(LRURG))#2
34 S LRURGNAM=$S(LRURG="":"",$D(LRSTAT(LRURG))#2:LRSTAT(LRURG),1:"")
35 S LRTEST=$$TST(LRTST)
36 S LRNX5=$S($L(LRTOV,".")=1:$P(LRNX5,"."),1:LRNX5)
37 S LRCPN=0 D LRCC
38 Q
39LRCC ;
40 S LRCPN=$O(^LRO(68,LRAA,1,LRST,1,LRNT,4,LRTST,1,LRCPN)) Q:'LRCPN S LRNODE=$G(^(LRCPN,0)) G:'LRNODE LRCC
41 I LRSITSEL,'$D(LRSITSEL(+$P(LRNODE,U,8))) G LRCC
42 I LRCAPS,'$D(LRCAPS(+LRNODE)) G LRCC
43 S LRCAPNAM=$$WKLDNAME^LRARCU(+LRNODE)
44 I (LRRTYP=2)&('LRCAPFLG) G LRCC
45 I (LRRTYP=3)&(LRCAPFLG) G LRCC
46 S:(LRCAPFLG)&($E(LRTEST)'="+") LRTEST="+"_LRTEST
47 S LRCP=LRCAPNUM G:'LRCP LRCC
48 S LRDOT="."_$P(LRCP,".",2)
49 S LRTESTCP=$E(LRTEST_" ",1,8)_" ["_LRCP_"]"
50 I LRCPSX,'$D(LRCPSX(LRDOT)) G LRCC
51 S LRMACN=+$O(^LAB(64.2,"F",LRDOT,0))
52 S LRMAC=$S($L($G(^LAB(64.2,LRMACN,0))):$P(^(0),U),1:"ERROR"_LRMACN)
53 S:'$D(^TMP("LRAR",$J,"TST/TOT")) ^("TST/TOT")=0 S ^("TST/TOT")=^("TST/TOT")+1
54 S:'$D(^TMP("LRAR",$J,"TST",LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
55 S:'$D(^TMP("LRAR",$J,"TST",LRTEST,LRLC)) ^(LRLC)=0 S ^(LRLC)=^(LRLC)+1
56 S:'$D(^TMP("LRAR",$J,"TST",LRTEST,LRLC,LRCP)) ^(LRCP)=0 S ^(LRCP)=^(LRCP)+1,J=^(LRCP)
57 S ^TMP("LRAR",$J,"TST",LRTEST,LRLC,LRCP,LRAANO,(J+1))=LRNX5_U_LRMAC_U_LRURGNAM
58 S:'$D(^TMP("LRAR",$J,"TST/LOC",LRLC)) ^(LRLC)=0 S ^(LRLC)=^(LRLC)+1
59 S:'$D(^TMP("LRAR",$J,"TST/LRM",LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
60 S:'$D(^TMP("LRAR",$J,"TST/LRM",LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
61 I LRCNTL D
62 . S:'$D(^TMP("LRAR",$J,"TST/CTL",LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
63 . S:'$D(^TMP("LRAR",$J,"TST/CTL",LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
64 I LRURGNAM'="" D
65 . S:'$D(^TMP("LRAR",$J,"TST/URG",LRPTYP,LRURGNAM)) ^(LRURGNAM)=0 S ^(LRURGNAM)=^(LRURGNAM)+1
66 . S:'$D(^TMP("LRAR",$J,"TST/URG",LRPTYP,LRURGNAM,LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
67 . S:'$D(^TMP("LRAR",$J,"TST/URG","A",LRURGNAM)) ^(LRURGNAM)=0 S ^(LRURGNAM)=^(LRURGNAM)+1
68 . S:'$D(^TMP("LRAR",$J,"TST/URG","A",LRURGNAM,LRTEST)) ^(LRTEST)=0 S ^(LRTEST)=^(LRTEST)+1
69 S:'$D(^TMP("LRAR",$J,"DATE",LRNX5D)) ^(LRNX5D)=0 S ^(LRNX5D)=^(LRNX5D)+1
70 S:'$D(^TMP("LRAR",$J,"DATE",LRNX5D,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1
71 S:'$D(^TMP("LRAR",$J,"DAY",LRNX5D)) ^(LRNX5D)=0 S ^(LRNX5D)=^(LRNX5D)+1
72 S:'$D(^TMP("LRAR",$J,"DAY",LRNX5D,LRMAC)) ^(LRMAC)=0 S ^(LRMAC)=^(LRMAC)+1
73 S:'$D(^TMP("LRAR",$J,"DAY",LRNX5D,LRMAC,LRTESTCP)) ^(LRTESTCP)=0 S ^(LRTESTCP)=^(LRTESTCP)+1,J=^(LRTESTCP)
74 G LRCC
75 Q
76TST(X) ; this returns the print test name otherwise the test name.
77 N LRDA
78 ;tests are truncated if greater than 7 chars long
79 S LRDA=$G(X) Q:'LRDA "Unknown"
80 Q:'$D(^LAB(60,LRDA,0))#2 "Unknown"
81 Q:$P($G(^LAB(60,LRDA,.1)),U)'="" $P($G(^(.1)),U)
82 Q $S($L($P(^LAB(60,LRDA,0),U))>7:$E($P(^LAB(60,LRDA,0),U),1,6)_"*",1:$P(^LAB(60,LRDA,0),U))
83CHKPAT(LRIOPAT,LRLTYP,LRFIL) ; return flag indicating if this record is for
84 ; a patient type selected for this report and if so, what type.
85 S LRCNTL=$S(LRFIL=62.3:1,1:0)
86 I ("OW"[LRLTYP)&((LRFIL=2)!(LRFIL=67))&(LRIOPAT["I") Q "1I" ; Inpatient
87 I ("OW"'[LRLTYP)&((LRFIL=2)!(LRFIL=67))&(LRIOPAT["O") Q "1O" ; Outpatient
88 I (LRIOPAT["R") Q "1R" ; Other
89 Q 0
Note: See TracBrowser for help on using the repository browser.