source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPU.m@ 1432

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

initial load of WorldVistAEHR

File size: 518 bytes
RevLine 
[613]1LRAPU ;AVAMC/REG - PATH UTILITY ;8/11/95 08:59 ;
2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
3 S (A,B)=0 F S A=$O(^LRO(68,A)) Q:'A I $P($G(^LRO(68,A,0)),"^",2)=LRSS,$G(^(3,DUZ(2),0)) S B=B+1,B(B)=A
4 I B=0 S Y=-1 Q ;W $C(7),!!,"There are no accession areas for ",LRSS,!,"Please have responsible person enter one in Accession File (#68)."
5 I B=1!($D(LR("M"))) S Y(0)=^LRO(68,B(B),0),X=$P(Y(0),U),Y=B(B)_U_X K A,B Q
6 S DIC=68,DIC(0)="AEQMZ",DIC("S")="I $P(^(0),U,2)=LRSS&(+$G(^(3,+DUZ(2),0)))" D ^DIC K DIC S X=$P(Y,U,2) Q
Note: See TracBrowser for help on using the repository browser.