|
Last change
on this file since 1042 was 613, checked in by George Lilly, 15 years ago |
|
initial load of WorldVistAEHR
|
|
File size:
722 bytes
|
| Line | |
|---|
| 1 | ECXLAB1 ;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
|
|---|
| 3 | EN ;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.
