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

BWUPLD.m

Go to the documentation of this file. 
  1. BWUPLD ;IHS/ANMC/MWR - UPLOAD: UPLOAD LAB FILES;11-Feb-2003 18:09;PLS
  1.  ;;2.0;WOMEN'S HEALTH;**8**;MAY 16, 1996
  1.  ;;* MICHAEL REMILLARD, DDS * ALASKA NATIVE MEDICAL CENTER *
  1.  ;;  CALLED BY OPTION: "BW UPLD LOAD LAB FILES" TO UPLOAD FROM HFS
  1.  ;;  COMMERCIAL LAB ABBREVIATION TABLES AND RESULTS.
  1.  ;
  1.  ;---> THIS ROUTINE UPLOADS THE SELECTED HOST FILE: EITHER A
  1.  ;---> TABLE OF RESULTS ABBREVIATIONS FROM A COMMERCIAL LAB,
  1.  ;---> OR A FILE OF LAB TEST RESULTS FROM A COMMERCIAL.
  1.  ;---> THE HOST FILE IS FIRST READ INTO A TEMPORARY "HOLDING" FILE,
  1.  ;---> CONVERTED FROM FIXED LENGTH IF NECESSARY DURING THE READ.
  1.  ;---> THEN A SECOND ROUTINE IS CALLED TO MOVE DATA FROM THE
  1.  ;---> TEMPORARY FILE INTO THE APPROPRIATE PERMANENT FILE.
  1.  ;
  1. START ;EP
  1.  N BWHNDL
  1.  S BWHNDL="WHEALTH"
  1.  D SETVARS^BWUTL5
  1.  D TITLE^BWUTL5("UTILITY TO IMPORT LAB RESULTS")
  1.  W !!?3,"NOTE: THIS UTILITY IS FOR USE ONLY WITH CORNING CLINICAL"
  1.  W " LABORATORIES."
  1.  S BWHFS=$P(^BWSITE(DUZ(2),0),U,14)
  1.  I BWHFS']"" D  Q
  1.  .W !!?5,"No Host File Path has been specified in the Site Parameters."
  1.  .W !?5,"Edit the Site Parameters or contact your site manager.",!
  1.  .D DIRZ^BWUTL3
  1.  ;
  1.  ;---> CHOOSE FILE TO UPLOAD.
  1.  N DIR,DIRUT,Y
  1.  W !!!?3,"Choose lab name and type of file to upload."
  1.  W !?3,"(Note: The Corning Table must be loaded before the Corning "
  1.  W "Results.)"
  1.  S DIR("A")="     Select file name and type"
  1.  S DIR(0)="SMO^CT:Corning Table;CR:Corning Results"
  1.  D HELP1
  1.  D ^DIR
  1.  I Y=-1!($D(DIRUT)) S BWPOP=1 G EXIT
  1.  S BWA=Y
  1.  ;---> BELOW, BWGBL IDENTIFIES THE TEMPORARY FILE, BWRTN IDENTIFIES
  1.  ;---> THE ROUTINE FOR CONVERTING THE DATA (FROM FIXED LENGTH, ETC.)
  1.  ;---> AND FOR TRANSFERING THE DATA FROM THE TEMPORARY FILE TO THE
  1.  ;---> PERMANENT FILE.
  1.  D
  1.  .I BWA="CT" S BWRTN="^BWUPTNI",BWGBL="^BWTNI(" Q
  1.  .I BWA="CR" S BWRTN="^BWUPRNI",BWGBL="^BWRNI(" Q
  1.  I '$D(@(BWGBL_"0)")) W !,"Receiving global does not exist." Q
  1.  S BWGBLN=$P(@(BWGBL_"0)"),U)
  1.  ;
  1.  ;---> ASK FOR HOST FILE NAME.
  1.  K DIR
  1.  W !!?5,"Enter the name of the file you wish to import."
  1.  W !?5,"Do not include any slashes in the filename.",!
  1.  S DIR(0)="FOA",DIR("A")="     Enter filename: "
  1.  S DIR("?")="     Enter the filename without any path "
  1.  S DIR("?")=DIR("?")_"--just the filename itself."
  1.  D ^DIR
  1.  I $D(DIRUT) S BWPOP=1 Q
  1.  S BWFLNM=Y
  1.  ;
  1.  ;---> KILL OFF EXISTING TEMPORARY FILE GLOBAL.
  1.  D ZGBL^BWUTL8(BWGBL)
  1.  ;
  1. READ ;EP
  1.  ;---> READ LINES OF HOST FILE TEXT AND STUFF AS NODES IN ^BWTNI
  1.  S Y=$$OPEN^%ZISH(BWHNDL,BWHFS,BWFLNM,"R")
  1.  I Y D  Q
  1.  .W !?10,"* FAILURE TO OPEN HOST FILE: ",BWHFS,BWFLNM," (",Y,")"
  1.  .W !?10,"  CHECK FILENAME AND PATH IN SITE PARAMETERS.",!
  1.  .D DIRZ^BWUTL3
  1.  ;
  1.  W !!?5,"Uploading Host File to ",BWGBLN," file..."
  1.  U IO
  1.  F BWI=1:1 R BWLINE:DTIME Q:'$L(BWLINE)  D
  1.  .Q:$P(BWLINE,U)?1C.C
  1.  .;---> CONVERT FIXED LENGTH FIELDS TO VARIABLE, DELIMITED BY "^", ETC.
  1.  .N Y
  1.  .D @("CVT"_BWRTN_"(.BWLINE,.Y)")
  1.  .Q:BWLINE=""
  1.  .I 'Y S @(BWGBL_BWI_",0)")=BWLINE Q
  1.  .S @(BWGBL_BWI_",0)")=$P(BWLINE,U,1,12)
  1.  .S @(BWGBL_BWI_",1)")=$P(BWLINE,U,13,18)
  1.  .S @(BWGBL_BWI_",2)")=$P(BWLINE,U,19,25)
  1.  D ^%ZISC
  1.  ;
  1. INDEX ;EP
  1.  ;---> NOW INDEX THE FILE.
  1.  W !?5,"Indexing ",BWGBLN," file..."
  1.  S DIK=BWGBL D IXALL^DIK
  1.  ;
  1. TRANSFER ;EP
  1.  ;---> TRANSFER TEMPORARY TABLE ENTRIES TO PERMANENT FILE.
  1.  D @("TRANS"_BWRTN)
  1.  ;
  1.  W !?5,"Deleting ",BWGBLN," data..."
  1.  ;---> CLEANUP: KILL OFF EXISTING TEMPORARY FILE GLOBAL.
  1.  D ZGBL^BWUTL8(BWGBL)
  1.  W !?5,"Complete.",! D DIRZ^BWUTL3
  1.  ;
  1. EXIT ;EP
  1.  D KILLALL^BWUTL8
  1.  Q
  1.  ;
  1. HELPTX ;EP
  1.  N I,T,X S T="" F I=1:1:BWTAB S T=T_" "
  1.  F I=1:1 S X=$T(@BWLINL+I) Q:X'[";;"  S DIR("?",I)=T_$P(X,";;",2)
  1.  S DIR("?")=DIR("?",I-1) K DIR("?",I-1)
  1.  Q
  1.  ;
  1. HELP1 ;EP
  1.  ;;Table files contain the Abbreviations Table for the selected lab.
  1.  ;;Results files contain the coded results of patients' tests for
  1.  ;;the selected lab.
  1.  S BWTAB=5,BWLINL="HELP1" D HELPTX
  1.  Q