- 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