source: FOIAVistA/trunk/r/DSS_EXTRACTS-ECX/ECXLAB1.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 722 bytes
Line 
1ECXLAB1 ;ALB/JAP,BIR/CML,-Driver Routine for DSS Lab Extract; [ 03/20/97 11:54 AM ] ; 8/8/01 4:16pm
2 ;;3.0;DSS EXTRACTS;**8,37**;Dec 22, 1997
3EN ;entry point from option
4 N JJ,SS,LN,X,Y,DIRUT,DTOUT,DUOUT,DIR
5 I '$O(^ECX(728,0)) D Q
6 .W $C(7),!!,"You have not yet defined your facility in the DSS EXTRACTS file (#728)!"
7 .I ($E(IOST)="C") D
8 ..S SS=22-$Y F JJ=1:1:SS W !
9 ..K X,Y
10 ..S DIR(0)="E" W ! D ^DIR K DIR
11 ;Check for lmip flag (field .5) in file (#728), if empty string write message and terminate extract
12 I $G(^ECX(728,1,"LMIP"))'=1 D Q
13 .S $P(LN,"-",80)=""
14 .W !,"LAB Extracts cannot be generated without LMIP Codes.",!,"Please check with your LAB ADPAC or LAB Service."
15 .W !,"...exiting."
16 D BEG^ECXLABN
17 Q
Note: See TracBrowser for help on using the repository browser.