source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMIPLOG.m@ 1258

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

initial load of WorldVistAEHR

File size: 976 bytes
RevLine 
[613]1LRMIPLOG ;SLC/CJS/BA - PRINT BY LOG NUMBER ;2/19/91 10:53 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;from option LRMIPLOG
4BEGIN D ^LRPARAM D LOG
5END K D,DFN,DIC,DOB,I,J,K,LRAA,LRACC,LRAD,LRAN,LRCMNT,LRDAT,LRDFN,LRDPF,LREND,LRIDT,LRLLT,LRONESPC,LRONETST,LRPG,PNM,POP,R,SSN,X,X1,Y
6 Q
7LOG D LRAA^LRMIUT Q:LRAA<1 S LREND=0 S LRDAT=LRDT0,(LRADX,LRONETST,LRONESPC)=""
8 F I=0:0 S LRAD=$E(DT,2,3),%DT="",%DT("A")="Accession Date: ",%DT("B")=LRAD D DATE^LRWU Q:LREND!(Y'<2800000)
9 Q:LREND
10 S LRAD=$S($P(^LRO(68,LRAA,0),U,3)="Y":$E(Y,1,3)_"0000",1:Y)
11 W !!,"Enter Accession Numbers"
12 D LRAN^LRMIUT Q:'$O(LRAN(0))
13 S %ZIS("B")="",%ZIS="MQ" S ZTRTN="DQ^LRMIPLOG" D IO^LRWU
14 Q
15DQ ;dequeued
16 S:$D(ZTQUEUED) ZTREQ="@" U IO D DT^LRX
17 S LRAN=0 F I=0:0 S LRAN=+$O(LRAN(LRAN)) Q:LRAN<1 D SENDUP Q:LREND
18 Q
19SENDUP Q:'$D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)) S LRIDT=9999999-^(3),LRDFN=+^(0),LRLLT=^LR(LRDFN,"MI",LRIDT,0),LRACC=$P(LRLLT,U,6),LRCMNT=$S($D(^(99)):^(99),1:""),LRPG=0 D EN^LRMIPSZ1 Q:LREND
20 Q
Note: See TracBrowser for help on using the repository browser.