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

BEHODC.m

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