BEHODC ;MSC/IND/PLS - TIU Dictation Support ;29-Oct-2007 12:58;DKM
;;1.1;BEH COMPONENTS;**040001**;Mar 20, 2007
;=================================================================
; Return the list of titles defined in the Parameter File and
; accessible to the user.
GDTITLES(DATA) ;
N ARY,PARAM,CNT,LP,TITLEIEN,ENT
K DATA
S CNT=0,LP=0
S PARAM="BEHODC DICTATION NOTE TITLES"
S ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
D GETLST^XPAR(.ARY,ENT,PARAM,.FMT,.ERR)
I $G(ERR) K ARY S DATA=ERR
E D
.S DATA=$$TMPGBL^CIAVMRPC
.F S LP=$O(ARY(LP)) Q:LP<1 D
..S TITLEIEN=+$P(ARY(LP),U,2)
..I $$CANENTR^TIULP(TITLEIEN)&($$CANPICK^TIULP(TITLEIEN)) D
...S CNT=CNT+1,@DATA@(CNT)="s"_TITLEIEN_U_$$DOCNAME^TIUPLST(TITLEIEN)
Q
; Returns true if Title is part of the Dictated Documents class
ISDTITL(IEN) ;
Q $P($G(^TIU(8925.1,IEN,0)),U,4)="DOC"
;Q $$UP^XLFSTR($$DOCNAME^TIUPLST(+$$DOCCLASS^TIULC1(IEN)))="DICTATED DOCUMENTS"
; EP: Entry point for the tasked background processor to loop thru files
; in a system directory
BATCH N SRCD,ARCD,PRBD,FILE,MAXLN
S SRCD=$$GET^XPAR("ALL","BEHODC SOURCE FOLDER") ; source directory
S ARCD=$$GET^XPAR("ALL","BEHODC ARCHIVE FOLDER") ; archive directory
S PRBD=$$GET^XPAR("ALL","BEHODC PROBLEM FOLDER") ; problem directory
S MAXLN=+$$GET^XPAR("ALL","BEHODC MAXIMUM LINES") ; maximum lines for document
S MAXLN=$S(MAXLN:MAXLN,1:500) ;(default to 500)
S FILE="*.txt" ;file extension
D DIR^CIAUOS(SRCD_FILE,100)
F S FILE=$O(^UTILITY("DIR",$J,FILE)) Q:FILE="" D
.Q:FILE=".profile"
.D IMPORT(SRCD,FILE),RENAME^CIAUOS(SRCD_FILE,ARCD_$P(FILE,";")):ARCD'="",DELETE^CIAUOS(SRCD_FILE):ARCD=""
Q
IMPORT(SRCD,FN) ;
N FILE
S FILE=SRCD_FN ;build full filename
D GETFILE(FILE) ; put report text into TIU file
Q
; EP: Used by background processor to file a document
GETFILE(FILE) ;
; CODE TAKEN FROM TIUUPLD
;API will open FILE in read-only state
;Uses 'Captioned Headers'
N EOM,BUFIEN,TIUERR,TIUHDR,TIULN,TIUSRC,X
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
S TIUSRC=$P($G(TIUPRM0),U,9),EOM=$P($G(TIUPRM0),U,11)
S TIUSRC="H" ;DEFAULT TO HFS
S TIUHDR=$P(TIUPRM0,U,10)
S BUFIEN=$$MAKEBUF^TIUUPLD
D HFS(FILE,BUFIEN)
I +$O(^TIU(8925.2,BUFIEN,"TEXT",0))>0,'+$G(TIUERR) D FILE(BUFIEN)
I +$O(^TIU(8925.2,BUFIEN,"TEXT",0))'>0!+$G(TIUERR) D BUFPURGE^TIUPUTC(BUFIEN)
GETFILEX Q
HFS(FILE,DA) ;Read HFS File and Store in Buffer
N TIUI,X,$ET,XQA,XQAMSG
S $ET="",@$$TRAP^CIAUOS("HFSERR^BEHODC"),TIUI=0
D OPEN^CIAUOS(.FILE,"R")
F Q:$$READ^CIAUOS(.X,FILE) Q:$E(X,1,$L(EOM))=EOM!(X="^")!(X="^^") Q:TIUI>MAXLN D
.S TIUI=TIUI+1
.S ^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
S ^TIU(8925.2,DA,"TEXT",0)="^^"_$G(TIUI)_"^"_$G(TIUI)_"^"_DT_"^^^^"
I TIUI>MAXLN D
.K ^TIU(8925.2,DA,"TEXT")
.S XQA("G.BEHODC PROBLEM FILE")=""
.S XQAMSG="The "_FILE_" has exceeded the line limit for an uploaded TIU document."
.D SETUP^XQALERT
HFSERR D CLOSE^CIAUOS(.FILE)
; Move problem file to problem directory if defined
D:TIUI>MAXLN&(PRBD'="") RENAME^CIAUOS(SRCD_FILE,PRBD_$P(FILE,";"))
Q
; File the document
FILE(DA) ;
; Completes upload transaction, invokes filer/router
N DIE,DR,ZTIO,ZTDTH,ZTSAVE,ZTRTN,ZTDESC
I '$D(^TIU(8925.2,+DA,0)) G FILEX
S DIE="^TIU(8925.2,",DR=".04////"_$$NOW^TIULC D ^DIE
; Task background filer/router to process buffer record
S ZTIO="",ZTDTH=$H,ZTSAVE("DA")=""
S ZTRTN=$S($P(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
S ZTDESC="TIU Document Filer"
; If filer is NOT designated to run in the foreground, queue it
I '+$P(TIUPRM0,U,18) D G FILEX
. D ^%ZTLOAD
. ;W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!")
; Otherwise, run the filer in the foreground
W !!,"File Transfer Complete--Now Filing Records..."
D @ZTRTN
FILEX Q
BEHODC ;MSC/IND/PLS - TIU Dictation Support ;29-Oct-2007 12:58;DKM
+1 ;;1.1;BEH COMPONENTS;**040001**;Mar 20, 2007
+2 ;=================================================================
+3 ; Return the list of titles defined in the Parameter File and
+4 ; accessible to the user.
GDTITLES(DATA) ;
+1 NEW ARY,PARAM,CNT,LP,TITLEIEN,ENT
+2 KILL DATA
+3 SET CNT=0
SET LP=0
+4 SET PARAM="BEHODC DICTATION NOTE TITLES"
+5 SET ENT=$$ENT^CIAVMRPC(PARAM,.ENT)
+6 DO GETLST^XPAR(.ARY,ENT,PARAM,.FMT,.ERR)
+7 IF $GET(ERR)
KILL ARY
SET DATA=ERR
+8 IF '$TEST
Begin DoDot:1
+9 SET DATA=$$TMPGBL^CIAVMRPC
+10 FOR
SET LP=$ORDER(ARY(LP))
IF LP<1
QUIT
Begin DoDot:2
+11 SET TITLEIEN=+$PIECE(ARY(LP),U,2)
+12 IF $$CANENTR^TIULP(TITLEIEN)&($$CANPICK^TIULP(TITLEIEN))
Begin DoDot:3
+13 SET CNT=CNT+1
SET @DATA@(CNT)="s"_TITLEIEN_U_$$DOCNAME^TIUPLST(TITLEIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+14 QUIT
+15 ; Returns true if Title is part of the Dictated Documents class
ISDTITL(IEN) ;
+1 QUIT $PIECE($GET(^TIU(8925.1,IEN,0)),U,4)="DOC"
+2 ;Q $$UP^XLFSTR($$DOCNAME^TIUPLST(+$$DOCCLASS^TIULC1(IEN)))="DICTATED DOCUMENTS"
+3 ; EP: Entry point for the tasked background processor to loop thru files
+4 ; in a system directory
BATCH NEW SRCD,ARCD,PRBD,FILE,MAXLN
+1 ; source directory
SET SRCD=$$GET^XPAR("ALL","BEHODC SOURCE FOLDER")
+2 ; archive directory
SET ARCD=$$GET^XPAR("ALL","BEHODC ARCHIVE FOLDER")
+3 ; problem directory
SET PRBD=$$GET^XPAR("ALL","BEHODC PROBLEM FOLDER")
+4 ; maximum lines for document
SET MAXLN=+$$GET^XPAR("ALL","BEHODC MAXIMUM LINES")
+5 ;(default to 500)
SET MAXLN=$SELECT(MAXLN:MAXLN,1:500)
+6 ;file extension
SET FILE="*.txt"
+7 DO DIR^CIAUOS(SRCD_FILE,100)
+8 FOR
SET FILE=$ORDER(^UTILITY("DIR",$JOB,FILE))
IF FILE=""
QUIT
Begin DoDot:1
+9 IF FILE=".profile"
QUIT
+10 DO IMPORT(SRCD,FILE)
IF ARCD'=""
DO RENAME^CIAUOS(SRCD_FILE,ARCD_$PIECE(FILE,";"))
IF ARCD=""
DO DELETE^CIAUOS(SRCD_FILE)
End DoDot:1
+11 QUIT
IMPORT(SRCD,FN) ;
+1 NEW FILE
+2 ;build full filename
SET FILE=SRCD_FN
+3 ; put report text into TIU file
DO GETFILE(FILE)
+4 QUIT
+5 ; EP: Used by background processor to file a document
GETFILE(FILE) ;
+1 ; CODE TAKEN FROM TIUUPLD
+2 ;API will open FILE in read-only state
+3 ;Uses 'Captioned Headers'
+4 NEW EOM,BUFIEN,TIUERR,TIUHDR,TIULN,TIUSRC,X
+5 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+6 SET TIUSRC=$PIECE($GET(TIUPRM0),U,9)
SET EOM=$PIECE($GET(TIUPRM0),U,11)
+7 ;DEFAULT TO HFS
SET TIUSRC="H"
+8 SET TIUHDR=$PIECE(TIUPRM0,U,10)
+9 SET BUFIEN=$$MAKEBUF^TIUUPLD
+10 DO HFS(FILE,BUFIEN)
+11 IF +$ORDER(^TIU(8925.2,BUFIEN,"TEXT",0))>0
IF '+$GET(TIUERR)
DO FILE(BUFIEN)
+12 IF +$ORDER(^TIU(8925.2,BUFIEN,"TEXT",0))'>0!+$GET(TIUERR)
DO BUFPURGE^TIUPUTC(BUFIEN)
GETFILEX QUIT
HFS(FILE,DA) ;Read HFS File and Store in Buffer
+1 NEW TIUI,X,$ETRAP,XQA,XQAMSG
+2 SET $ETRAP=""
SET @$$TRAP^CIAUOS("HFSERR^BEHODC")
SET TIUI=0
+3 DO OPEN^CIAUOS(.FILE,"R")
+4 FOR
IF $$READ^CIAUOS(.X,FILE)
QUIT
IF $EXTRACT(X,1,$LENGTH(EOM))=EOM!(X="^")!(X="^^")
QUIT
IF TIUI>MAXLN
QUIT
Begin DoDot:1
+5 SET TIUI=TIUI+1
+6 SET ^TIU(8925.2,DA,"TEXT",TIUI,0)=$$STRIP^TIUUPLD(X)
End DoDot:1
+7 SET ^TIU(8925.2,DA,"TEXT",0)="^^"_$GET(TIUI)_"^"_$GET(TIUI)_"^"_DT_"^^^^"
+8 IF TIUI>MAXLN
Begin DoDot:1
+9 KILL ^TIU(8925.2,DA,"TEXT")
+10 SET XQA("G.BEHODC PROBLEM FILE")=""
+11 SET XQAMSG="The "_FILE_" has exceeded the line limit for an uploaded TIU document."
+12 DO SETUP^XQALERT
End DoDot:1
HFSERR DO CLOSE^CIAUOS(.FILE)
+1 ; Move problem file to problem directory if defined
+2 IF TIUI>MAXLN&(PRBD'="")
DO RENAME^CIAUOS(SRCD_FILE,PRBD_$PIECE(FILE,";"))
+3 QUIT
+4 ; File the document
FILE(DA) ;
+1 ; Completes upload transaction, invokes filer/router
+2 NEW DIE,DR,ZTIO,ZTDTH,ZTSAVE,ZTRTN,ZTDESC
+3 IF '$DATA(^TIU(8925.2,+DA,0))
GOTO FILEX
+4 SET DIE="^TIU(8925.2,"
SET DR=".04////"_$$NOW^TIULC
DO ^DIE
+5 ; Task background filer/router to process buffer record
+6 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("DA")=""
+7 SET ZTRTN=$SELECT($PIECE(TIUPRM0,U,16)="D":"MAIN^TIUPUTD",1:"MAIN^TIUPUTC")
+8 SET ZTDESC="TIU Document Filer"
+9 ; If filer is NOT designated to run in the foreground, queue it
+10 IF '+$PIECE(TIUPRM0,U,18)
Begin DoDot:1
+11 DO ^%ZTLOAD
+12 ;W !,$S($D(ZTSK):"Filer/Router Queued!",1:"Filer/Router Cancelled!")
End DoDot:1
GOTO FILEX
+13 ; Otherwise, run the filer in the foreground
+14 WRITE !!,"File Transfer Complete--Now Filing Records..."
+15 DO @ZTRTN
FILEX QUIT
