source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRUSP.m

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

initial load of FOIAVistA 6/30/08 version

File size: 1.1 KB
Line 
1LRUSP ;AVAMC/REG - ADD/DELETE SPECIAL STAIN ; 10/9/87 16:26 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 W !!?20,"Add or Delete " W LRAA(1)," SPECIAL STAIN"
4 W !!,"For ",LRH(0)," OK " S %=1 D YN^LRU Q:%<1 I %=2 S %DT="AEX" D ^%DT Q:Y<1 S LRAD=Y D D^LRU S LRH(0)=Y
5ASK R !,"Select Accession Number: ",LRAN:DTIME Q:LRAN=""!(LRAN[U) I LRAN'?1N.N W $C(7),!!,"Enter whole numbers only",!! G ASK
6 W " for ",LRH(0),!
7 I '$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) W $C(7),!!,"Accession # ",LRAN," for ",LRH(0)," not in file",!! G ASK
8 S LRDFN=+^LRO(68,LRAA,1,LRAD,1,LRAN,0),LRI=$P(^(3),U,5) G:'$D(^LR(LRDFN,0)) BAD S Y=^(0),X=$P(Y,U,2),X=^DIC(X,0,"GL"),Y=$P(Y,U,3)
9 S LRP=@(X_Y_",0)") W !,$P(LRP,U,1)," ID: ",$P(LRP,U,9) S Y=$P(LRP,U,3) D D^LRU W:Y'[1700 " DOB: ",Y S:'$D(^LRO(68,LRAA,1,LRAD,LRAN,5,0)) ^(0)="^68.05PA^^"
10 W !!,"ACC # ",LRAN S Y=$S($D(^LRO(68,LRAA,1,LRAD,1,LRAN,3)):+^(3),1:"") D:Y D^LRU W " DATE RECEIVED: ",Y," OK " S %=1 D YN^LRU G:%'=1 ASK
11T W ! S DIC="^LRO(68,LRAA,1,LRAD,1,LRAN,5,",DIC(0)="AELMOQ",DLAYGO=68 D ^DIC K DIC,DLAYGO Q:X=""!(X[U)
12 S DIE="^LRO(68,LRAA,1,LRAD,1,LRAN,5,",DA=+Y,DR=".01;2:99" D ^DIE K DIE G T
13BAD W $C(7),!!,"Entry not in file",!! G ASK
Note: See TracBrowser for help on using the repository browser.