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

APCLUPST.m

Go to the documentation of this file. 
  1. APCLUPST  ;CMI/TUCSON/LAB - LOAD NCI STUDY PATIENTS  
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ;
  1.  ;
  1. START ;start processing
  1.  I '$G(DUZ) W !,"Log into Kernel first" Q
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option should be used to upload patients from a file that is in the ",!,"format ASUFAC^HRN^DOB and store those patients in a search template."
  1.  W !,"You will be asked to provide the directory path and filename where the",!,"file resides.  You will also be asked to enter the name of the search",!,"template that will be created.",!
  1.  W !,"When entering the directory path, enter a full path name with the ending '/'",!,"for example, /usr/spool/uucppublic/ or /usr/mumps/.  When entering the ",!,"filename enter the extension as well, for example, MYFILE.TXT.",!
  1. TEMPLATE ;If Template was selected
  1.  W !,"You must first enter the name of the search template to be created."
  1.  K APCLSTMP,APCLSNAM
  1.  D ^APCLSTMP
  1.  I $G(APCLSTMP)="" D XIT Q
  1.  ;
  1. UPL ;
  1.  S APCLQUIT=0 D FILE
  1.  I $G(APCLQUIT) W !!,"Bye.  File not accessed.",! D XIT Q
  1.  W !!,APCLC," records were read from the file.",!
  1.  W !!,"Now enter the device to which the results of the upload, including any errors",!,"will be printed.",!
  1. ZIS ;call to XBDBQUE
  1.  S XBRP="PRINT^APCLUPST",XBRC="PROC^APCLUPST",XBRX="XIT^APCLUPST",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  D XIT
  1.  Q
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  S APCL80S="*****************************************************************************"
  1.  S APCLPG=0 K APCLQUIT
  1.  D HEAD
  1.  W !,"Read ",APCLCNT," records.   Loaded ",APCLLOAD," patients.",!
  1.  W !!,"The following errors occurred: "
  1.  S APCLX=0 F  S APCLX=$O(^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX)) Q:APCLX'=+APCLX  D
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
  1.  .W !,^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX)
  1.  .Q
  1.  K ^XTMP("APCLUPST",APCLJ,APCLH)
  1.  D XIT
  1.  Q
  1. E ;
  1.  S APCLE=APCLE+1
  1.  S ^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLE)=X
  1.  Q
  1. PROC ;EP - called from xbdbque
  1.  S APCLE=0
  1.  S APCLCNT=0,APCLLOAD=0
  1.  S APCLR=0 F  S APCLR=$O(^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLR)) Q:APCLR'=+APCLR  S APCLX=^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLR,0) D LOAD
  1.  Q
  1. XIT ;
  1.  K AUPNLK
  1.  D EN^XBVK("APCL")
  1.  D ^XBFMK
  1.  Q
  1. LOAD ;
  1.  S AUPNLK("ALL")="",AUPNLK("INAC")=""
  1.  Q:APCLX=""
  1.  S APCLCNT=APCLCNT+1 ;total number of records read
  1.  S APCLFACN=$P(APCLX,U),APCLHRN=$P(APCLX,U,2) S:$E(APCLHRN?1N) APCLHRN=+APCLHRN S APCLDOB=$P(APCLX,U,3)
  1.  S APCLFAC=$O(^AUTTLOC("C",APCLFACN,0))
  1.  I 'APCLFAC D
  1.  .S X="Record "_APCLCNT_" COULD NOT FIND LOCATION "_APCLFACN_" IN THE LOCATION TABLE" D E
  1.  K %DT I APCLDOB]"" S X=APCLDOB,%DT="P" D ^%DT S APCLDOB=Y
  1.  S APCLPAT="" D GETPAT ;find patient with available data
  1.  Q:'APCLPAT
  1.  S ^DIBT(APCLSTMP,1,APCLPAT)=""
  1.  S APCLLOAD=APCLLOAD+1
  1.  Q
  1. GETPAT ;
  1.  S X=0 F  S X=$O(^AUPNPAT("D",APCLHRN,X)) Q:X'=+X  I $D(^AUPNPAT("D",APCLHRN,X,APCLFAC)) S APCLPAT=X
  1.  I 'APCLPAT S X="Record: "_APCLCNT_" Couldn't find patient with chart number "_APCLHRN_" at facility "_APCLFACN D E Q
  1.  I APCLDOB'=$P(^DPT(APCLPAT,0),U,3) S X="Record: "_APCLCNT_" DOB does not match patient found." S APCLPAT="" D E
  1.  Q
  1. FILE ;upload global
  1.  S APCLJ=$J,APCLH=$H
  1.  D XTMP^APCLOSUT("APCLUPST","PCC - UPLOAD INTO SEARCH TEMPLATE")
  1. DIR ;
  1.  W !,"Now enter the directory path and filename where the data can be found.",!
  1.  S APCLDIR=""
  1.  S DIR(0)="F^3:30",DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)" K DA D ^DIR K DIR
  1.  I $D(DIRUT) W !!,"Directory not entered!!  Bye." S APCLQUIT=1 Q
  1.  S APCLDIR=Y
  1.  S APCLFILE=""
  1.  S DIR(0)="F^2:30",DIR("A")="Enter filename w /ext (i.e. NCIDATA.TXT)" K DA D ^DIR K DIR
  1.  G:$D(DIRUT) DIR
  1.  S APCLFILE=Y
  1.  W !,"Directory=",APCLDIR,"  ","File=",APCLFILE,"  reading file Hold on...",!
  1. READF ;read file
  1.  NEW Y,X,I
  1.  S APCLC=1
  1.  S Y=$$OPEN^%ZISH(APCLDIR,APCLFILE,"R")
  1.  I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",APCLDIR,APCLFILE,"'." S APCLQUIT=1 Q
  1.  KILL ^XTMP("APCLUPST",APCLJ,APCLH)
  1.  F I=1:1 U IO R X:DTIME S X=$$STRIP(X) S ^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLC,0)=X,APCLC=APCLC+1 Q:$$STATUS^%ZISH=-1!(X="")
  1.  D ^%ZISC
  1.  W !!,"All done reading file",!
  1.  Q
  1. STRIP(Z) ;REMOVE CONTROL CHARACTERS
  1.  NEW I
  1.  F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
  1.  Q Z
  1.  ;
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  W APCL80S,!
  1.  W "*",?3,$P(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,?78,"*",!
  1.  W "*",?78,"*",!
  1.  W "RESULTS OF UPLOADING PATIENTS INTO A SEARCH TEMPLATE",!
  1.  W !,"SEARCH TEMPLATE CREATED: ",$P(^DIBT(APCLSTMP,0),U),!
  1.  W APCL80S,!
  1.  Q
  1.  ;