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

TIUFC.m

Go to the documentation of this file.
  1. TIUFC ; SLC/MAM - LM Template C (Create DDEF) INIT, Action NEXT LEVEL ;4/28/97 21:46
  1. ;;1.0;TEXT INTEGRATION UTILITIES;;Jun 20, 1997
  1. EN ; -- main entry point for LM Template TIUFC CREATE DDEF
  1. ; Requires TIUFWHO, set in options TIUFC CREATE DDEFS MGR/NATL
  1. ; TIUFCBEG is used to set message bar msgs:
  1. ; TIUFCBEG = 1 if done EN, no more, not even Start Over.
  1. ; 0 if Selected any action
  1. ; C in TIUFCDA,TIUFDITM,TIUFCNM,TIUFCTYP,TIUFCTDA,TIUFCLPS stands for
  1. ;Current Position, the highlighted line.
  1. N TIUF,TIUFCMSG,CREATEDA,CREATENM,TIUFCONE,TIUFCBEG,TIUFCDA,TIUFCITM,TIUFCNM,TIUFTMPL,TIUFCTYP,TIUFCTDA,TIUFCLPS,TIUFVCN1,XQORM,TIUFXNOD,TIUFLFT
  1. S TIUFTMPL="C",TIUFCLPS=0
  1. N TIUFPRIV D SETUP^TIUFL S:$D(DTOUT) VALMQUIT=1 G:$G(VALMQUIT) ENX
  1. S TIUFCBEG=1
  1. I "NM"[TIUFWHO D EN^VALM("TIUFC CREATE DDEFS MGR")
  1. ENX Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)=$$CENTER^TIUFL("BASICS",79)
  1. Q
  1. ;
  1. N DEFAULT
  1. I $G(TIUFCONE) S TIUFCBEG=0 ;used in $$vmsg
  1. I '$G(TIUFCONE) S TIUFCONE=1
  1. S VALMSG=$$VMSG^TIUFL
  1. D SHOW^VALM
  1. S TIUFCITM=$$HASITEMS^TIUFLF1(TIUFCDA) ;Update since items could have been deleted
  1. S DEFAULT=$S($G(TIUFCTYP)="CL"&'$G(TIUFCITM):"Class/DocumentClass",$G(TIUFCTYP)="CL":"Next Level",$G(TIUFCTYP)="DC":"Title",$G(TIUFCTYP)="TL":"Component",$G(TIUFCTYP)='"CO":"Next Level",1:"")
  1. S XQORM("B")=$S(VALMCNT'>(VALMBG+VALM("LINES")-1):DEFAULT,1:"Next Screen")
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. D INIT^TIUFH I $D(DTOUT) G INITX
  1. S TIUFCDA=^TMP("TIUF",$J,"CLINDOC") ;IFN of Current Position in Hier
  1. S TIUFCNM="CLINICAL DOCUMENTS",TIUFCITM=$$HASITEMS^TIUFLF1(TIUFCDA),TIUFCTYP="CL"
  1. K TIUFCMSG
  1. S VALMBG=1
  1. S TIUFCMSG(1)=" To create a new CLINICAL DOCUMENTS, Select Class/DocumentClass; or to Go Down a"
  1. I VALMCNT'>VALM("LINES") S TIUFCMSG(2)="Level, Select NEXT LEVEL." G INITX
  1. I VALMCNT>VALM("LINES") S TIUFCMSG(2)="Level, Screen to (+/-) Desired CLINICAL DOCUMENTS Item, and Select NEXT LEVEL."
  1. INITX I $D(DTOUT) S VALMQUIT=1
  1. Q
  1. ;
  1. NEXT ; TEMPLATE C Action Next Level: Navigate hierarchy.
  1. ; Called by Protocol TIUFC ACTION NEXT LEVEL
  1. ; Requires TIUFI,TIUFCNM,TIUFCDA,TIUFCITM
  1. N LINENO,INFO,BEG,END,XPDLCNT,DIR,X,Y,NODE0,LINENO,IINFO,NMWIDTH,TIUFY
  1. N MISSITEM,TIUFXNOD,XFLG,IFILEDA,DTOUT,DIRUT,DIROUT,ILINE
  1. S VALMBCK="",TIUFXNOD=$G(XQORNOD(0))
  1. S LINENO=$O(^TMP("TIUF1IDX",$J,"DAF",TIUFCDA,""))
  1. S INFO=^TMP("TIUF1IDX",$J,LINENO),XPDLCNT=$P(INFO,U,3)
  1. S BEG=(LINENO+1),END=LINENO+XPDLCNT
  1. I TIUFCTYP="TL" W !!," You are already at the bottom Level. To create Components, enter Component,",!,"or to create Subcomponents, select Detailed Display for the Component, then",!,"edit Items of Component.",! D PAUSE^TIUFXHLX G NEXTX
  1. I 'TIUFCITM W !!," No Items: You must Create Items at this level before going down a level.",! D PAUSE^TIUFXHLX G NEXTX
  1. S TIUFY=+$P($P(TIUFXNOD,U,4),"=",2) I TIUFY'<BEG,TIUFY'>END,$D(^TMP("TIUF1IDX",$J,TIUFY)) G POSTSEL
  1. K TIUFY
  1. S DIR(0)="NA^"_BEG_":"_END_":0"
  1. S DIR("?",1)=" Your Current Position in the Hierarchy is "_TIUFCNM_"."
  1. S DIR("?",2)="You have chosen to go down another level. This means you must select an Item"
  1. S DIR("?")="of "_TIUFCNM_", Line "_BEG_"-"_END_"."
  1. I TIUFCITM S DIR("A")=" Select "_TIUFCNM_" Item (Line "_BEG_"-"_END_"): " D ^DIR S TIUFY=Y K DIR,X,Y I 'TIUFY G NEXTX
  1. POSTSEL S VALMBCK="R"
  1. S IINFO=^TMP("TIUF1IDX",$J,TIUFY),TIUFCDA=$P(IINFO,U,2),TIUFCTDA=$P(IINFO,U,6)
  1. S ILINE=^TMP("TIUF1",$J,TIUFY,0)
  1. S NODE0=^TIU(8925.1,TIUFCDA,0),TIUFCTYP=$P(NODE0,U,4) S:TIUFCTYP="DOC" TIUFCTYP="TL"
  1. I TIUFCTYP="" W !!," Entry has no Type. Can't select entry",! D PAUSE^TIUFXHLX G NEXTX
  1. S TIUFCNM=$P(NODE0,U) I $L(TIUFCNM)>30 S TIUFCNM=$E(TIUFCNM,1,30)
  1. K TIUFCMSG
  1. D PARSE^TIUFLLM(.INFO)
  1. S VALMCNT=VALMCNT-XPDLCNT D COLLAPSE^TIUFH1(.INFO) S TIUFCLPS=1
  1. ; Has already been expanded; so items exist in file:
  1. S LINENO=+INFO+1
  1. D CEXPAND1 S VALMCNT=VALMCNT+1,TIUFCLPS=0
  1. D CNTRL^VALM10(LINENO-1,8,^TMP("TIUF",$J,"NMWIDTH"),IOINORM,IOINORM)
  1. D CNTRL^VALM10(LINENO,8,^TMP("TIUF",$J,"NMWIDTH"),IOINHI,IOINORM)
  1. D PARSE^TIUFLLM(.IINFO)
  1. S IFILEDA=$P(IINFO,U,2),MISSITEM=$$MISSITEM^TIUFLF4(IFILEDA)
  1. I MISSITEM W !!," Corrupt Database: File Entry "_IFILEDA_" Has Nonexistent Item "_MISSITEM_" ; See IRM",! D PAUSE^TIUFXHLX S VALMBCK="" G NEXTX
  1. D EXPAND1^TIUFH1(.IINFO)
  1. S VALMCNT=VALMCNT+IINFO("XPDLCNT")
  1. S VALMBG=+INFO
  1. S TIUFCITM=$S($P(IINFO,U,3):1,1:0)
  1. I TIUFCTYP="TL" S TIUFCMSG(1)=" You have reached the bottom of the tree. Select COMPONENT to create a",TIUFCMSG(2)="Component of "_TIUFCNM_". (SubComponents are created using Detailed Display",TIUFCMSG(3)="and then Item.)" G NEXTX
  1. S TIUFCMSG(1)=" Select "_$S(TIUFCTYP="DC":"TITLE",1:"CLASS/DOCUMENTCLASS")_" to create a new "_TIUFCNM
  1. S TIUFCMSG(2)="or to Go Down a Level, Select NEXT LEVEL."
  1. I VALMCNT>VALM("LINES") S TIUFCMSG(2)="or to Go Down a Level, Screen to (+/-) Desired ",TIUFCMSG(3)=TIUFCNM_" Item, and Select NEXT LEVEL."
  1. NEXTX I $D(DTOUT) S VALMBCK="Q"
  1. Q
  1. ;
  1. CEXPAND1 ; Set selected Next Level item of current branch into LM array (i.e. expands current branch to include next level. DOESN'T Update INFO.
  1. S $P(ILINE," ")=LINENO_$S($L(LINENO)<$L(+IINFO):" ",1:"")
  1. S ^TMP("TIUF1",$J,LINENO,0)=ILINE
  1. S $P(IINFO,U)=LINENO,^TMP("TIUF1IDX",$J,LINENO)=IINFO
  1. S ^TMP("TIUF1",$J,"IDX",LINENO,LINENO)=""
  1. S ^TMP("TIUF1IDX",$J,"DAF",TIUFCDA,LINENO)=""
  1. S $P(^TMP("TIUF1IDX",$J,+INFO),U,3)=1
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("TIUF1",$J),^TMP("TIUFB",$J),^TMP("TIUF1IDX",$J),^TMP("TIUFBIDX",$J),^TMP("TIUF",$J),IOELALL
  1. D CLEAN^VALM10
  1. Q
  1. ;