APCLUPST ;CMI/TUCSON/LAB - LOAD NCI STUDY PATIENTS
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;
;
;
START ;start processing
I '$G(DUZ) W !,"Log into Kernel first" Q
W:$D(IOF) @IOF
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."
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.",!
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.",!
TEMPLATE ;If Template was selected
W !,"You must first enter the name of the search template to be created."
K APCLSTMP,APCLSNAM
D ^APCLSTMP
I $G(APCLSTMP)="" D XIT Q
;
UPL ;
S APCLQUIT=0 D FILE
I $G(APCLQUIT) W !!,"Bye. File not accessed.",! D XIT Q
W !!,APCLC," records were read from the file.",!
W !!,"Now enter the device to which the results of the upload, including any errors",!,"will be printed.",!
ZIS ;call to XBDBQUE
S XBRP="PRINT^APCLUPST",XBRC="PROC^APCLUPST",XBRX="XIT^APCLUPST",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
;
PRINT ;EP - called from xbdbque
S APCL80S="*****************************************************************************"
S APCLPG=0 K APCLQUIT
D HEAD
W !,"Read ",APCLCNT," records. Loaded ",APCLLOAD," patients.",!
W !!,"The following errors occurred: "
S APCLX=0 F S APCLX=$O(^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX)) Q:APCLX'=+APCLX D
.I $Y>(IOSL-4) D HEAD Q:$D(APCLQUIT)
.W !,^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX)
.Q
K ^XTMP("APCLUPST",APCLJ,APCLH)
D XIT
Q
E ;
S APCLE=APCLE+1
S ^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLE)=X
Q
PROC ;EP - called from xbdbque
S APCLE=0
S APCLCNT=0,APCLLOAD=0
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
Q
XIT ;
K AUPNLK
D EN^XBVK("APCL")
D ^XBFMK
Q
LOAD ;
S AUPNLK("ALL")="",AUPNLK("INAC")=""
Q:APCLX=""
S APCLCNT=APCLCNT+1 ;total number of records read
S APCLFACN=$P(APCLX,U),APCLHRN=$P(APCLX,U,2) S:$E(APCLHRN?1N) APCLHRN=+APCLHRN S APCLDOB=$P(APCLX,U,3)
S APCLFAC=$O(^AUTTLOC("C",APCLFACN,0))
I 'APCLFAC D
.S X="Record "_APCLCNT_" COULD NOT FIND LOCATION "_APCLFACN_" IN THE LOCATION TABLE" D E
K %DT I APCLDOB]"" S X=APCLDOB,%DT="P" D ^%DT S APCLDOB=Y
S APCLPAT="" D GETPAT ;find patient with available data
Q:'APCLPAT
S ^DIBT(APCLSTMP,1,APCLPAT)=""
S APCLLOAD=APCLLOAD+1
Q
GETPAT ;
S X=0 F S X=$O(^AUPNPAT("D",APCLHRN,X)) Q:X'=+X I $D(^AUPNPAT("D",APCLHRN,X,APCLFAC)) S APCLPAT=X
I 'APCLPAT S X="Record: "_APCLCNT_" Couldn't find patient with chart number "_APCLHRN_" at facility "_APCLFACN D E Q
I APCLDOB'=$P(^DPT(APCLPAT,0),U,3) S X="Record: "_APCLCNT_" DOB does not match patient found." S APCLPAT="" D E
Q
FILE ;upload global
S APCLJ=$J,APCLH=$H
D XTMP^APCLOSUT("APCLUPST","PCC - UPLOAD INTO SEARCH TEMPLATE")
DIR ;
W !,"Now enter the directory path and filename where the data can be found.",!
S APCLDIR=""
S DIR(0)="F^3:30",DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)" K DA D ^DIR K DIR
I $D(DIRUT) W !!,"Directory not entered!! Bye." S APCLQUIT=1 Q
S APCLDIR=Y
S APCLFILE=""
S DIR(0)="F^2:30",DIR("A")="Enter filename w /ext (i.e. NCIDATA.TXT)" K DA D ^DIR K DIR
G:$D(DIRUT) DIR
S APCLFILE=Y
W !,"Directory=",APCLDIR," ","File=",APCLFILE," reading file Hold on...",!
READF ;read file
NEW Y,X,I
S APCLC=1
S Y=$$OPEN^%ZISH(APCLDIR,APCLFILE,"R")
I Y W !,*7,"CANNOT OPEN (OR ACCESS) FILE '",APCLDIR,APCLFILE,"'." S APCLQUIT=1 Q
KILL ^XTMP("APCLUPST",APCLJ,APCLH)
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="")
D ^%ZISC
W !!,"All done reading file",!
Q
STRIP(Z) ;REMOVE CONTROL CHARACTERS
NEW I
F I=1:1:$L(Z) I (32>$A($E(Z,I))) S Z=$E(Z,1,I-1)_" "_$E(Z,I+1,999)
Q Z
;
HEAD I 'APCLPG G HEAD1
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
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W APCL80S,!
W "*",?3,$P(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,?78,"*",!
W "*",?78,"*",!
W "RESULTS OF UPLOADING PATIENTS INTO A SEARCH TEMPLATE",!
W !,"SEARCH TEMPLATE CREATED: ",$P(^DIBT(APCLSTMP,0),U),!
W APCL80S,!
Q
;
APCLUPST ;CMI/TUCSON/LAB - LOAD NCI STUDY PATIENTS
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;
+3 ;
+4 ;
START ;start processing
+1 IF '$GET(DUZ)
WRITE !,"Log into Kernel first"
QUIT
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,"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."
+4 WRITE !,"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.",!
+5 WRITE !,"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.",!
TEMPLATE ;If Template was selected
+1 WRITE !,"You must first enter the name of the search template to be created."
+2 KILL APCLSTMP,APCLSNAM
+3 DO ^APCLSTMP
+4 IF $GET(APCLSTMP)=""
DO XIT
QUIT
+5 ;
UPL ;
+1 SET APCLQUIT=0
DO FILE
+2 IF $GET(APCLQUIT)
WRITE !!,"Bye. File not accessed.",!
DO XIT
QUIT
+3 WRITE !!,APCLC," records were read from the file.",!
+4 WRITE !!,"Now enter the device to which the results of the upload, including any errors",!,"will be printed.",!
ZIS ;call to XBDBQUE
+1 SET XBRP="PRINT^APCLUPST"
SET XBRC="PROC^APCLUPST"
SET XBRX="XIT^APCLUPST"
SET XBNS="APCL"
+2 DO ^XBDBQUE
+3 DO XIT
+4 QUIT
+5 ;
PRINT ;EP - called from xbdbque
+1 SET APCL80S="*****************************************************************************"
+2 SET APCLPG=0
KILL APCLQUIT
+3 DO HEAD
+4 WRITE !,"Read ",APCLCNT," records. Loaded ",APCLLOAD," patients.",!
+5 WRITE !!,"The following errors occurred: "
+6 SET APCLX=0
FOR
SET APCLX=$ORDER(^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+8 WRITE !,^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLX)
+9 QUIT
End DoDot:1
+10 KILL ^XTMP("APCLUPST",APCLJ,APCLH)
+11 DO XIT
+12 QUIT
E ;
+1 SET APCLE=APCLE+1
+2 SET ^XTMP("APCLUPST",APCLJ,APCLH,"ERRORS",APCLE)=X
+3 QUIT
PROC ;EP - called from xbdbque
+1 SET APCLE=0
+2 SET APCLCNT=0
SET APCLLOAD=0
+3 SET APCLR=0
FOR
SET APCLR=$ORDER(^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLR))
IF APCLR'=+APCLR
QUIT
SET APCLX=^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLR,0)
DO LOAD
+4 QUIT
XIT ;
+1 KILL AUPNLK
+2 DO EN^XBVK("APCL")
+3 DO ^XBFMK
+4 QUIT
LOAD ;
+1 SET AUPNLK("ALL")=""
SET AUPNLK("INAC")=""
+2 IF APCLX=""
QUIT
+3 ;total number of records read
SET APCLCNT=APCLCNT+1
+4 SET APCLFACN=$PIECE(APCLX,U)
SET APCLHRN=$PIECE(APCLX,U,2)
IF $EXTRACT(APCLHRN?1N)
SET APCLHRN=+APCLHRN
SET APCLDOB=$PIECE(APCLX,U,3)
+5 SET APCLFAC=$ORDER(^AUTTLOC("C",APCLFACN,0))
+6 IF 'APCLFAC
Begin DoDot:1
+7 SET X="Record "_APCLCNT_" COULD NOT FIND LOCATION "_APCLFACN_" IN THE LOCATION TABLE"
DO E
End DoDot:1
+8 KILL %DT
IF APCLDOB]""
SET X=APCLDOB
SET %DT="P"
DO ^%DT
SET APCLDOB=Y
+9 ;find patient with available data
SET APCLPAT=""
DO GETPAT
+10 IF 'APCLPAT
QUIT
+11 SET ^DIBT(APCLSTMP,1,APCLPAT)=""
+12 SET APCLLOAD=APCLLOAD+1
+13 QUIT
GETPAT ;
+1 SET X=0
FOR
SET X=$ORDER(^AUPNPAT("D",APCLHRN,X))
IF X'=+X
QUIT
IF $DATA(^AUPNPAT("D",APCLHRN,X,APCLFAC))
SET APCLPAT=X
+2 IF 'APCLPAT
SET X="Record: "_APCLCNT_" Couldn't find patient with chart number "_APCLHRN_" at facility "_APCLFACN
DO E
QUIT
+3 IF APCLDOB'=$PIECE(^DPT(APCLPAT,0),U,3)
SET X="Record: "_APCLCNT_" DOB does not match patient found."
SET APCLPAT=""
DO E
+4 QUIT
FILE ;upload global
+1 SET APCLJ=$JOB
SET APCLH=$HOROLOG
+2 DO XTMP^APCLOSUT("APCLUPST","PCC - UPLOAD INTO SEARCH TEMPLATE")
DIR ;
+1 WRITE !,"Now enter the directory path and filename where the data can be found.",!
+2 SET APCLDIR=""
+3 SET DIR(0)="F^3:30"
SET DIR("A")="Enter directory path (i.e. /usr/spool/uucppublic/)"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
WRITE !!,"Directory not entered!! Bye."
SET APCLQUIT=1
QUIT
+5 SET APCLDIR=Y
+6 SET APCLFILE=""
+7 SET DIR(0)="F^2:30"
SET DIR("A")="Enter filename w /ext (i.e. NCIDATA.TXT)"
KILL DA
DO ^DIR
KILL DIR
+8 IF $DATA(DIRUT)
GOTO DIR
+9 SET APCLFILE=Y
+10 WRITE !,"Directory=",APCLDIR," ","File=",APCLFILE," reading file Hold on...",!
READF ;read file
+1 NEW Y,X,I
+2 SET APCLC=1
+3 SET Y=$$OPEN^%ZISH(APCLDIR,APCLFILE,"R")
+4 IF Y
WRITE !,*7,"CANNOT OPEN (OR ACCESS) FILE '",APCLDIR,APCLFILE,"'."
SET APCLQUIT=1
QUIT
+5 KILL ^XTMP("APCLUPST",APCLJ,APCLH)
+6 FOR I=1:1
USE IO
READ X:DTIME
SET X=$$STRIP(X)
SET ^XTMP("APCLUPST",APCLJ,APCLH,"PATIENTS",APCLC,0)=X
SET APCLC=APCLC+1
IF $$STATUS^%ZISH=-1!(X="")
QUIT
+7 DO ^%ZISC
+8 WRITE !!,"All done reading file",!
+9 QUIT
STRIP(Z) ;REMOVE CONTROL CHARACTERS
+1 NEW I
+2 FOR I=1:1:$LENGTH(Z)
IF (32>$ASCII($EXTRACT(Z,I)))
SET Z=$EXTRACT(Z,1,I-1)_" "_$EXTRACT(Z,I+1,999)
+3 QUIT Z
+4 ;
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE APCL80S,!
+3 WRITE "*",?3,$PIECE(^DIC(4,DUZ(2),0),U),?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,?78,"*",!
+4 WRITE "*",?78,"*",!
+5 WRITE "RESULTS OF UPLOADING PATIENTS INTO A SEARCH TEMPLATE",!
+6 WRITE !,"SEARCH TEMPLATE CREATED: ",$PIECE(^DIBT(APCLSTMP,0),U),!
+7 WRITE APCL80S,!
+8 QUIT
+9 ;
