TIUPS169 ; SLC/MAM - After installing TIU*1*169 ; 7/27/2004
;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
; Option TIU169 DDEFS, C&P WORKSHEETS. Run after installing patch 169.
; External References
; DBIA 3409 ^USR(8930,"B"
BEGIN ; Create DDEFS
N TIUY,DESDC,TIUDUPS,TIUQUIT
W !!,"This option creates Document Definitions (DDEFS) for C&P Worksheets."
W !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
; -- Set ^XTMP deletion date for about 2 years hence:
; Set it even if all are already created, in case it's in test
; for more than 2 years, so sites can reset it by running option.
S ^XTMP("TIU169",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU169 DDEFS, C&P WORKSHEETS"
; -- Check if ALL done; check for Class Clinical Coord:
I $G(^XTMP("TIU169","DONE"))="ALL" D Q
. W !,"All C&P Document Definitions have already been created."
I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D Q
. W !,"I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU169":
D SETBASIC^TIUEN169
; -- If DC was created or designated on previous run, set DESDC &
; check for new dups:
I $G(^XTMP("TIU169",1,"DONE")) D Q:$G(TIUQUIT)
. S DESDC=^XTMP("TIU169",1,"DONE")
. W !!,"Proceeding with Document Class C&P EXAMINATION REPORTS..."
. D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
. I $G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
; -- If DC NOT created or designated on previous run, designate:
I '$G(^XTMP("TIU169",1,"DONE")) D Q:$G(TIUQUIT)
. S DESDC=$$DESGNATE^TIUEN169
. I +DESDC=-1 W !,"Try later." S TIUQUIT=1 Q
. D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
. I +$G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
. ; -- User has not designated a DC:
. I +DESDC=0 D Q:$G(TIUQUIT)
. . S TIUY=$$READ^TIUU("YO","I will create a new Document Class with new Titles under it. OK","YES")
. . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
. ; -- No matching titles in Des DC:
. I +DESDC>0,'$G(TIUDUPS("INDC")) D Q:$G(TIUQUIT)
. . S TIUY=$$READ^TIUU("YO","I will create the new Titles under Document Class "_$P(DESDC,U,2)_". OK","YES")
. . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
. ; -- Matching titles in Des DC:
. I +DESDC>0,+$G(TIUDUPS("INDC")) D Q:$G(TIUQUIT)
. . D LISTDUPS^TIUEN169(.TIUDUPS,1)
. . S TIUY=$$READ^TIUU("YO","I will create the non-matching Titles under Document Class "_$P(DESDC,U,2)_", and skip the matching Titles. OK","YES")
. . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
. ; -- If user has designated DC and agreed, change Name & set DONE node:
. I +DESDC>0 D
. . N DCNAME,DA,DIE,DR,X,Y S DCNAME="C&P EXAMINATION REPORTS",DA=+DESDC,DIE=8925.1,DR=".01///^S X=DCNAME" D ^DIE
. . S ^XTMP("TIU169",1,"DONE")=+DESDC
; -- If DDEFs are being skipped, set their DONE nodes:
N NUM,ALLFLG S ALLFLG=1
F NUM=2:1:58 D
. I '$G(TIUDUPS("INDC",NUM)),'$D(^XTMP("TIU169",NUM,"DONE")) S ALLFLG=0 Q
. I $G(TIUDUPS("INDC",NUM)) S ^XTMP("TIU169",NUM,"DONE")=TIUDUPS("INDC",NUM)
I ALLFLG S ^XTMP("TIU169","DONE")="ALL" D Q
. W !,"All Document Definitions have already been created."
W ! K IOP N %ZIS S %ZIS="Q" D ^%ZIS
I POP W !,"Nothing created." K POP Q
I $D(IO("Q")) K IO("Q") D Q
.S ZTRTN="MAIN^TIUPS169"
.S ZTDESC="Create DDEFS for C&P Worksheets - TIU*1*169"
.D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
.K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
.D HOME^%ZIS
U IO D MAIN,^%ZISC
Q
;
MAIN ; Create DDEFS for C&P
N TMPCNT,TIUSTTS
K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J)
; -- Begin message array ^TMP("TIU169MSG",$J:
S TMPCNT=0
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" ***** Document Definitions (DDEFS) for C&P Worksheets *****"
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Creating the Document Definitions..."
; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
; of array ^TMP("TIU169":
D SETDATA^TIU169D
; -- Loop through DDEFS to create them:
N NUM
F NUM=1:1:58 D
. N TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
. ; -- If DDEF was previously created by this option, or is being
. ; skipped, quit and get next DDEF:
. S TIUIEN=+$G(^XTMP("TIU169",NUM,"DONE")) Q:TIUIEN
. ; -- If not, create new DDEF:
. S YDDEF=$$CREATE(NUM)
. ; -- If DDEF couldn't be created or was found by lookup
. ; instead of being created, quit and get next DDEF:
. I $G(^TMP("TIU169ERR",$J,NUM))="CREATE" Q
. S TIUDA=+YDDEF
. ; -- Call FILE to stuff fields from ^TMP("TIU169",$J,"FILEDATA",NUM:
. D FILE(NUM,TIUDA)
. I $G(^TMP("TIU169ERR",$J,NUM))="FILE" D DELETE^TIU169D(TIUDA) Q
. ; -- Add item to parent, stuff item data:
. S PIEN=$$PARENT(NUM)
. I $G(^TMP("TIU169ERR",$J,NUM))="FINDPARENT" D DELETE^TIU169D(TIUDA) Q
. S ITEMDA=+$$ADDITEM^TIU169D(NUM,TIUDA,PIEN)
. I $G(^TMP("TIU169ERR",$J,NUM))="ADDITEM" D DELETE^TIU169D(TIUDA) Q
. D FILEITEM^TIU169D(NUM,PIEN,ITEMDA)
. I $G(^TMP("TIU169ERR",$J,NUM))="FILEITEM" D DELETE^TIU169D(TIUDA,PIEN,ITEMDA) Q
. ; -- DDEF NUM has been created and edited successfully:
. S ^XTMP("TIU169",NUM,"DONE")=TIUDA
. Q
; -- Add results from CREATE loop to message array:
N NUM S NUM=0
I $O(^TMP("TIU169ERR",$J,NUM))="" D G MAINX
. S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="All Document Definitions have now been created successfully."
. S ^XTMP("TIU169","DONE")="ALL"
. ; -- Kill indiv DONE nodes:
. N NUMBER F NUMBER=1:1:58 K ^XTMP("TIU169",NUMBER)
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Problems were encountered creating the following Document Definitions:"
F S NUM=$O(^TMP("TIU169ERR",$J,NUM)) Q:NUM="" D
. N PROB S PROB=^TMP("TIU169ERR",$J,NUM)
. D
. . I PROB="CREATE" S PROB="Couldn't create DDEF." Q
. . I PROB="FILE" S PROB="Couldn't file fields. DDEF deleted." Q
. . I PROB="FINDPARENT" S PROB="Couldn't find parent. DDEF deleted." Q
. . I PROB="ADDITEM" S PROB="Couldn't add DDEF to parent. DDEF deleted."
. . I PROB="FILEITEM" S PROB="Couldn't file Menu Text. DDEF deleted."
. S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=$S(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU169",$J,"BASICS",NUM,"NAME")_": "
. S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" "_PROB
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="come back and rerun the option."
MAINX ; Exit
; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
; now in case modules are run separately for debugging:
K TIUIERR,^TMP("DIERR",$J)
; -- Finish message array ^TMP("TIU169MSG",$J and print it:
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" *************"
D PRINT^TIU169D
K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J),^TMP("TIU169",$J)
Q
;
PARENT(NUM) ; Return IEN of parent new DDEF should be added to
N PIEN,PNUM
; Parent node has form:
; ^TMP("TIU169",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
; ^TMP("TIU169",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
S PIEN=$G(^TMP("TIU169",$J,"DATA",NUM,"PIEN"))
; -- If parent IEN is known, we're done:
I +PIEN G PARENTX
; -- If not, get DDEF# of parent
S PNUM=+$G(^TMP("TIU169",$J,"DATA",NUM,"PNUM"))
; -- Get Parent IEN from "DONE" node, which was set
; when parent was created:
S PIEN=+$G(^XTMP("TIU169",PNUM,"DONE"))
PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
. S ^TMP("TIU169ERR",$J,NUM)="FINDPARENT"
Q PIEN
;
FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
; ^TMP("TIU169",$J,"FILEDATA",NUM,Field#)
N TIUFPRIV,FDA
K ^TMP("DIERR",$J)
S TIUFPRIV=1
M FDA(8925.1,TIUDA_",")=^TMP("TIU169",$J,"FILEDATA",NUM)
D FILE^DIE("TE","FDA")
I $D(^TMP("DIERR",$J)) S ^TMP("TIU169ERR",$J,NUM)="FILE"
Q
;
CREATE(NUM) ; Create new DDEF entry
N DIC,DLAYGO,DA,X,Y
S DIC="^TIU(8925.1,",DLAYGO=8925.1
S DIC(0)="LX",X=^TMP("TIU169",$J,"BASICS",NUM,"NAME")
S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU169",$J,"BASICS",NUM,"INTTYPE")_""""
D ^DIC
I $P($G(Y),U,3)'=1 S ^TMP("TIU169ERR",$J,NUM)="CREATE"
Q $G(Y)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS169 8560 printed Oct 16, 2024@18:44:43 Page 2
TIUPS169 ; SLC/MAM - After installing TIU*1*169 ; 7/27/2004
+1 ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
+2 ; Option TIU169 DDEFS, C&P WORKSHEETS. Run after installing patch 169.
+3 ; External References
+4 ; DBIA 3409 ^USR(8930,"B"
BEGIN ; Create DDEFS
+1 NEW TIUY,DESDC,TIUDUPS,TIUQUIT
+2 WRITE !!,"This option creates Document Definitions (DDEFS) for C&P Worksheets."
+3 WRITE !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
+4 ; -- Set ^XTMP deletion date for about 2 years hence:
+5 ; Set it even if all are already created, in case it's in test
+6 ; for more than 2 years, so sites can reset it by running option.
+7 SET ^XTMP("TIU169",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU169 DDEFS, C&P WORKSHEETS"
+8 ; -- Check if ALL done; check for Class Clinical Coord:
+9 IF $GET(^XTMP("TIU169","DONE"))="ALL"
Begin DoDot:1
+10 WRITE !,"All C&P Document Definitions have already been created."
End DoDot:1
QUIT
+11 IF $ORDER(^USR(8930,"B","CLINICAL COORDINATOR",""))=""
Begin DoDot:1
+12 WRITE !,"I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
End DoDot:1
QUIT
+13 ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU169":
+14 DO SETBASIC^TIUEN169
+15 ; -- If DC was created or designated on previous run, set DESDC &
+16 ; check for new dups:
+17 IF $GET(^XTMP("TIU169",1,"DONE"))
Begin DoDot:1
+18 SET DESDC=^XTMP("TIU169",1,"DONE")
+19 WRITE !!,"Proceeding with Document Class C&P EXAMINATION REPORTS..."
+20 DO TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
+21 IF $GET(TIUDUPS("NOTINDC"))
DO LISTDUPS^TIUEN169(.TIUDUPS,0)
SET TIUQUIT=1
QUIT
End DoDot:1
if $GET(TIUQUIT)
QUIT
+22 ; -- If DC NOT created or designated on previous run, designate:
+23 IF '$GET(^XTMP("TIU169",1,"DONE"))
Begin DoDot:1
+24 SET DESDC=$$DESGNATE^TIUEN169
+25 IF +DESDC=-1
WRITE !,"Try later."
SET TIUQUIT=1
QUIT
+26 DO TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
+27 IF +$GET(TIUDUPS("NOTINDC"))
DO LISTDUPS^TIUEN169(.TIUDUPS,0)
SET TIUQUIT=1
QUIT
+28 ; -- User has not designated a DC:
+29 IF +DESDC=0
Begin DoDot:2
+30 SET TIUY=$$READ^TIUU("YO","I will create a new Document Class with new Titles under it. OK","YES")
+31 IF +TIUY'=1
WRITE !,"OK, try again when you're ready."
SET TIUQUIT=1
End DoDot:2
if $GET(TIUQUIT)
QUIT
+32 ; -- No matching titles in Des DC:
+33 IF +DESDC>0
IF '$GET(TIUDUPS("INDC"))
Begin DoDot:2
+34 SET TIUY=$$READ^TIUU("YO","I will create the new Titles under Document Class "_$PIECE(DESDC,U,2)_". OK","YES")
+35 IF +TIUY'=1
WRITE !,"OK, try again when you're ready."
SET TIUQUIT=1
End DoDot:2
if $GET(TIUQUIT)
QUIT
+36 ; -- Matching titles in Des DC:
+37 IF +DESDC>0
IF +$GET(TIUDUPS("INDC"))
Begin DoDot:2
+38 DO LISTDUPS^TIUEN169(.TIUDUPS,1)
+39 SET TIUY=$$READ^TIUU("YO","I will create the non-matching Titles under Document Class "_$PIECE(DESDC,U,2)_", and skip the matching Titles. OK","YES")
+40 IF +TIUY'=1
WRITE !,"OK, try again when you're ready."
SET TIUQUIT=1
End DoDot:2
if $GET(TIUQUIT)
QUIT
+41 ; -- If user has designated DC and agreed, change Name & set DONE node:
+42 IF +DESDC>0
Begin DoDot:2
+43 NEW DCNAME,DA,DIE,DR,X,Y
SET DCNAME="C&P EXAMINATION REPORTS"
SET DA=+DESDC
SET DIE=8925.1
SET DR=".01///^S X=DCNAME"
DO ^DIE
+44 SET ^XTMP("TIU169",1,"DONE")=+DESDC
End DoDot:2
End DoDot:1
if $GET(TIUQUIT)
QUIT
+45 ; -- If DDEFs are being skipped, set their DONE nodes:
+46 NEW NUM,ALLFLG
SET ALLFLG=1
+47 FOR NUM=2:1:58
Begin DoDot:1
+48 IF '$GET(TIUDUPS("INDC",NUM))
IF '$DATA(^XTMP("TIU169",NUM,"DONE"))
SET ALLFLG=0
QUIT
+49 IF $GET(TIUDUPS("INDC",NUM))
SET ^XTMP("TIU169",NUM,"DONE")=TIUDUPS("INDC",NUM)
End DoDot:1
+50 IF ALLFLG
SET ^XTMP("TIU169","DONE")="ALL"
Begin DoDot:1
+51 WRITE !,"All Document Definitions have already been created."
End DoDot:1
QUIT
+52 WRITE !
KILL IOP
NEW %ZIS
SET %ZIS="Q"
DO ^%ZIS
+53 IF POP
WRITE !,"Nothing created."
KILL POP
QUIT
+54 IF $DATA(IO("Q"))
KILL IO("Q")
Begin DoDot:1
+55 SET ZTRTN="MAIN^TIUPS169"
+56 SET ZTDESC="Create DDEFS for C&P Worksheets - TIU*1*169"
+57 DO ^%ZTLOAD
WRITE !,$SELECT($DATA(ZTSK):"Request Queued!",1:"Request Canceled!")
+58 KILL ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
+59 DO HOME^%ZIS
End DoDot:1
QUIT
+60 USE IO
DO MAIN
DO ^%ZISC
+61 QUIT
+62 ;
MAIN ; Create DDEFS for C&P
+1 NEW TMPCNT,TIUSTTS
+2 KILL ^TMP("TIU169MSG",$JOB),^TMP("TIU169ERR",$JOB)
+3 ; -- Begin message array ^TMP("TIU169MSG",$J:
+4 SET TMPCNT=0
+5 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=" ***** Document Definitions (DDEFS) for C&P Worksheets *****"
+6 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)="Creating the Document Definitions..."
+7 ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
+8 ; of array ^TMP("TIU169":
+9 DO SETDATA^TIU169D
+10 ; -- Loop through DDEFS to create them:
+11 NEW NUM
+12 FOR NUM=1:1:58
Begin DoDot:1
+13 NEW TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
+14 ; -- If DDEF was previously created by this option, or is being
+15 ; skipped, quit and get next DDEF:
+16 SET TIUIEN=+$GET(^XTMP("TIU169",NUM,"DONE"))
if TIUIEN
QUIT
+17 ; -- If not, create new DDEF:
+18 SET YDDEF=$$CREATE(NUM)
+19 ; -- If DDEF couldn't be created or was found by lookup
+20 ; instead of being created, quit and get next DDEF:
+21 IF $GET(^TMP("TIU169ERR",$JOB,NUM))="CREATE"
QUIT
+22 SET TIUDA=+YDDEF
+23 ; -- Call FILE to stuff fields from ^TMP("TIU169",$J,"FILEDATA",NUM:
+24 DO FILE(NUM,TIUDA)
+25 IF $GET(^TMP("TIU169ERR",$JOB,NUM))="FILE"
DO DELETE^TIU169D(TIUDA)
QUIT
+26 ; -- Add item to parent, stuff item data:
+27 SET PIEN=$$PARENT(NUM)
+28 IF $GET(^TMP("TIU169ERR",$JOB,NUM))="FINDPARENT"
DO DELETE^TIU169D(TIUDA)
QUIT
+29 SET ITEMDA=+$$ADDITEM^TIU169D(NUM,TIUDA,PIEN)
+30 IF $GET(^TMP("TIU169ERR",$JOB,NUM))="ADDITEM"
DO DELETE^TIU169D(TIUDA)
QUIT
+31 DO FILEITEM^TIU169D(NUM,PIEN,ITEMDA)
+32 IF $GET(^TMP("TIU169ERR",$JOB,NUM))="FILEITEM"
DO DELETE^TIU169D(TIUDA,PIEN,ITEMDA)
QUIT
+33 ; -- DDEF NUM has been created and edited successfully:
+34 SET ^XTMP("TIU169",NUM,"DONE")=TIUDA
+35 QUIT
End DoDot:1
+36 ; -- Add results from CREATE loop to message array:
+37 NEW NUM
SET NUM=0
+38 IF $ORDER(^TMP("TIU169ERR",$JOB,NUM))=""
Begin DoDot:1
+39 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)="All Document Definitions have now been created successfully."
+40 SET ^XTMP("TIU169","DONE")="ALL"
+41 ; -- Kill indiv DONE nodes:
+42 NEW NUMBER
FOR NUMBER=1:1:58
KILL ^XTMP("TIU169",NUMBER)
End DoDot:1
GOTO MAINX
+43 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=""
+44 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)="Problems were encountered creating the following Document Definitions:"
+45 FOR
SET NUM=$ORDER(^TMP("TIU169ERR",$JOB,NUM))
if NUM=""
QUIT
Begin DoDot:1
+46 NEW PROB
SET PROB=^TMP("TIU169ERR",$JOB,NUM)
+47 Begin DoDot:2
+48 IF PROB="CREATE"
SET PROB="Couldn't create DDEF."
QUIT
+49 IF PROB="FILE"
SET PROB="Couldn't file fields. DDEF deleted."
QUIT
+50 IF PROB="FINDPARENT"
SET PROB="Couldn't find parent. DDEF deleted."
QUIT
+51 IF PROB="ADDITEM"
SET PROB="Couldn't add DDEF to parent. DDEF deleted."
+52 IF PROB="FILEITEM"
SET PROB="Couldn't file Menu Text. DDEF deleted."
End DoDot:2
+53 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=$SELECT(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU169",$JOB,"BASICS",NUM,"NAME")_": "
+54 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=" "_PROB
End DoDot:1
+55 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=""
+56 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
+57 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)="come back and rerun the option."
MAINX ; Exit
+1 ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
+2 ; now in case modules are run separately for debugging:
+3 KILL TIUIERR,^TMP("DIERR",$JOB)
+4 ; -- Finish message array ^TMP("TIU169MSG",$J and print it:
+5 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=""
+6 SET TMPCNT=TMPCNT+1
SET ^TMP("TIU169MSG",$JOB,TMPCNT)=" *************"
+7 DO PRINT^TIU169D
+8 KILL ^TMP("TIU169MSG",$JOB),^TMP("TIU169ERR",$JOB),^TMP("TIU169",$JOB)
+9 QUIT
+10 ;
PARENT(NUM) ; Return IEN of parent new DDEF should be added to
+1 NEW PIEN,PNUM
+2 ; Parent node has form:
+3 ; ^TMP("TIU169",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
+4 ; ^TMP("TIU169",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
+5 SET PIEN=$GET(^TMP("TIU169",$JOB,"DATA",NUM,"PIEN"))
+6 ; -- If parent IEN is known, we're done:
+7 IF +PIEN
GOTO PARENTX
+8 ; -- If not, get DDEF# of parent
+9 SET PNUM=+$GET(^TMP("TIU169",$JOB,"DATA",NUM,"PNUM"))
+10 ; -- Get Parent IEN from "DONE" node, which was set
+11 ; when parent was created:
+12 SET PIEN=+$GET(^XTMP("TIU169",PNUM,"DONE"))
PARENTX IF 'PIEN!'$DATA(^TIU(8925.1,PIEN,0))
Begin DoDot:1
+1 SET ^TMP("TIU169ERR",$JOB,NUM)="FINDPARENT"
End DoDot:1
+2 QUIT PIEN
+3 ;
FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
+1 ; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
+2 ; ^TMP("TIU169",$J,"FILEDATA",NUM,Field#)
+3 NEW TIUFPRIV,FDA
+4 KILL ^TMP("DIERR",$JOB)
+5 SET TIUFPRIV=1
+6 MERGE FDA(8925.1,TIUDA_",")=^TMP("TIU169",$JOB,"FILEDATA",NUM)
+7 DO FILE^DIE("TE","FDA")
+8 IF $DATA(^TMP("DIERR",$JOB))
SET ^TMP("TIU169ERR",$JOB,NUM)="FILE"
+9 QUIT
+10 ;
CREATE(NUM) ; Create new DDEF entry
+1 NEW DIC,DLAYGO,DA,X,Y
+2 SET DIC="^TIU(8925.1,"
SET DLAYGO=8925.1
+3 SET DIC(0)="LX"
SET X=^TMP("TIU169",$JOB,"BASICS",NUM,"NAME")
+4 SET DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU169",$JOB,"BASICS",NUM,"INTTYPE")_""""
+5 DO ^DIC
+6 IF $PIECE($GET(Y),U,3)'=1
SET ^TMP("TIU169ERR",$JOB,NUM)="CREATE"
+7 QUIT $GET(Y)
