Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECXLAB1

ECXLAB1.m

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