source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRGEN1.m@ 1374

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1LRGEN1 ;SLC/RWF-GENERAL DATA DISPLAY ;2/19/91 10:35
2 ;;5.2;LAB SERVICE;**201,221**;Sep 27, 1994
3DQ ;dequeued from LRGEN
4 N LRPDT,LRPTF,LRPAGE
5 S LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")
6 S LRPRTF="Report Range [ "_$$FMTE^XLFDT($P(LRSDT,"."),"5MZ")_" - "_$$FMTE^XLFDT(9999999-$P(LREDT,"."),"5MZ")_" ]"
7 K LRNOTE,LRSV S (LRPAGE,LRNOTE,LREND)=0
8 S:'$G(LRIDT) LRIDT=1 W:$E(IOST,1,2)="C-" @IOF
9 S $P(LRDASH,"-",(IOM-1))="",$P(LREQUAL,"=",(IOM-1))=""
10 S LRWPL=IOSL-(3*LRIX)/LRIX
11 S:$D(ZTQUEUED) ZTREQ="@" U IO
12 S LRCW=LRCW-3,LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
13 D DT^LRX,PT^LRX,HEAD
14 F D NX Q:LREND!(LRIDT<1)!(LRIDT>LREDT)
15 D WRTLN
16 K LRDASH,LREQUAL,LRAGE,LRRB,LRTREAT,LRUNKNOW,SEX,AGE
17 D KVAR^VADPT
18 Q
19WRTLN W ! W:$E(IOST,1,2)="P-" @IOF D ^%ZISC Q
20NX I LRY'<LRWPL D BOT:LRSC=LRIX,HEAD:'LREND Q:LREND I LRSC>1,LRSUB(LRSC)=LRSUB(LRSC-1) D NSET Q
21 S:LRIDT>1 LRIDT=+$O(^LR(LRDFN,LRSUB,LRIDT)) I LRIDT<1!(LRIDT>LREDT) D Q
22 . I LRSC>1,LRSUB(LRSC)=LRSUB(LRSC-1) D NSET
23 . S LRY=LRWPL D BOT,LAST
24 S Z=$S($D(^LR(LRDFN,LRSUB,LRIDT,0)):^(0),1:"") Q:'$P(Z,U,3) I LRTP,LRTP'=$P(Z,U,5) Q
25 S LRNOP=1,II=0 F S II=+$O(LRND(II)) Q:II<1 S:$D(^LR(LRDFN,LRSUB,LRIDT,LRND(II))) LRNOP=0
26 Q:LRNOP I $D(LRSUB(LRSC+1)),LRSUB(LRSC+1)=LRSUB(LRSC) S LRSV(LRY)=LRIDT
27 D LRPR
28 Q
29NSET S LRSSP=0 F S LRSSP=+$O(LRSV(LRSSP)) Q:LRSSP<1 S LRIDT=LRSV(LRSSP),Z=^LR(LRDFN,LRSUB,LRIDT,0) D LRPR
30 S LRIDT=LRIDT(LRSC-1),LRY=LRWPL
31 Q
32LRPR N LRSAMP
33 S X=+Z,LRTN=$P(Z,U,5),LRSAMP="?" S:LRTN'="" LRSAMP=$S($D(^LAB(61,LRTN,0)):$E(^(0),1,3),1:"?")
34 S LRDAT=$$FMTE^XLFDT(X,"5MZ")
35 S T=" "
36 S:X["." T=" "_$E(X_"00000",9,10)_":"_$E(X_"0000",11,12)_" "
37 S LRFOOT=" "
38 I $O(^LR(LRDFN,LRSUB,LRIDT,1,0))>0 D
39 . S:'$D(LRNOTE(-1,LRIDT)) LRNOTE=$G(LRNOTE)+1,LRNOTE(LRNOTE)=LRIDT,LRNOTE(-1,LRIDT)=LRNOTE S LRFOOT=$C(LRNOTE(-1,LRIDT)+64)
40 W !,LRFOOT," ",LRDAT S LRY=LRY+1
41 W !,?13,LRSAMP,?20 S X=$D(^LR(LRDFN,LRSUB,LRIDT,0)),LRX=$X,LRY=LRY+1
42 F I=S1:1:S2 D
43 . S X=$S($D(^LR(LRDFN,LRSUB,LRIDT,LRND(I))):^(LRND(I)),1:""),LRFFLG=$P(X,U,2),X=$P(X,U)
44 . W ?LRX,@$S(X'=""&$D(LRPR(I)):LRPR(I),1:"$J(X,LRCW)")," ",LRFFLG
45 . S LRX=LRX+3+LRCW
46 Q
47HEAD Q:'$G(LRIDT)!($G(LREND))
48 S:'$G(LRY) LRY=2 S:'$D(LRPRTF) $P(LRPRTF," ",20)=""
49 S $P(LRDASH,"-",(IOM-1))="",$P(LREQUAL,"=",(IOM-1))=""
50 S LREND=0 I '$G(LRBOT) F Q:LREND D HD1 Q:'(LRIDT<1!(LRIDT>LREDT)) S LREND=1 F II=1:1:LRIX I LRIDT(II)>0,LRIDT(II)<LREDT S LREND=0 Q
51 Q:$G(LREND)
52 S:'$D(LRPDT) LRPDT=$$FMTE^XLFDT($$NOW^XLFDT,"5MZ")
53 I $G(LRSC)=1 D
54 . S LRPAGE=$G(LRPAGE)+1,LRY=2 W @IOF
55 . W !,"WORK COPY: ",PNM," ",SSN," Age:",AGE," ",?50,"Prt Date:",LRPDT
56 . W !,$$CJ^XLFSTR(LRPRTF_" Pg:"_LRPAGE,IOM) S LRY=LRY+1
57 S X=9999999-$O(^LR(LRDFN,"CH",LRIDT)) W !! W:'$L($G(LRHDR(LRSC,1))) ?13,"SPEC" W ?20,LRHDR(LRSC) S LRY=LRY+2
58 I $L(LRHDR(LRSC,2)) W !,$S($D(LRTHER):" Ther.",1:" Ref")," Range",?17,LRHDR(LRSC,2) S LRY=LRY+1
59 I $L(LRHDR(LRSC,1)) W !,?13,"SPEC",?20,LRHDR(LRSC,1) S LRY=LRY+1
60 W !,LREQUAL S LRY=LRY+1
61 Q
62HD1 Q:$G(LREND)
63 S LRIDT(LRSC)=LRIDT,LRSC=$S(LRSC<LRIX:LRSC+1,1:1),LRIDT=$G(LRIDT(LRSC)) Q:'LRIDT S S1=LRIX(LRSC)+1,S2=LRIX(LRSC+1)
64 I LRSC=1 K LRNOTE,LRSV S LRNOTE=0
65 I LRSUB'=LRSUB(LRSC) S LRSUB=LRSUB(LRSC) K LRSV
66 Q
67LAST W !,$$CJ^XLFSTR("[ *** End Of Report *** ]",IOM),!
68 S LREND=1
69 Q
70BOT D KEYCOM^LRX:$E(IOST,1,2)'="C-"
71 N II
72 W !,LRDASH
73 I $G(LRNOTE) F II=1:1:LRNOTE S LRIDT1=LRNOTE(II) D
74 . I LRY'<LRWPL D B1 Q:$G(LREND) S LRBOT=1 D HEAD K LRBOT
75 . W !,$C(II+64) S J=0 F S J=$O(^LR(LRDFN,LRSUB,LRIDT1,1,J)) Q:J<1 D
76 . . W ?5,^(J,0) W:$O(^LR(LRDFN,LRSUB,LRIDT1,1,J)) !
77 K LRNOTE S LRNOTE=0
78B1 W !,"WORK COPY - DO NOT FILE ",PNM,?60,SSN S LRY=2
79 I $E(IOST,1,2)="C-" W !?20," PRESS '^' TO STOP REPORT " R X:DTIME S:X="" X=1 S LREND=".^"[X Q:$G(LREND)
80 Q
Note: See TracBrowser for help on using the repository browser.