source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS169.m@ 862

Last change on this file since 862 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 8.2 KB
Line 
1TIUPS169 ; SLC/MAM - After installing TIU*1*169 ; 7/27/2004
2 ;;1.0;Text Integration Utilities;**169**;Jun 20, 1997
3 ; Option TIU169 DDEFS, C&P WORKSHEETS. Run after installing patch 169.
4 ; External References
5 ; DBIA 3409 ^USR(8930,"B"
6BEGIN ; Create DDEFS
7 N TIUY,DESDC,TIUDUPS,TIUQUIT
8 W !!,"This option creates Document Definitions (DDEFS) for C&P Worksheets."
9 W !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
10 ; -- Set ^XTMP deletion date for about 2 years hence:
11 ; Set it even if all are already created, in case it's in test
12 ; for more than 2 years, so sites can reset it by running option.
13 S ^XTMP("TIU169",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU169 DDEFS, C&P WORKSHEETS"
14 ; -- Check if ALL done; check for Class Clinical Coord:
15 I $G(^XTMP("TIU169","DONE"))="ALL" D Q
16 . W !,"All C&P Document Definitions have already been created."
17 I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D Q
18 . W !,"I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
19 ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU169":
20 D SETBASIC^TIUEN169
21 ; -- If DC was created or designated on previous run, set DESDC &
22 ; check for new dups:
23 I $G(^XTMP("TIU169",1,"DONE")) D Q:$G(TIUQUIT)
24 . S DESDC=^XTMP("TIU169",1,"DONE")
25 . W !!,"Proceeding with Document Class C&P EXAMINATION REPORTS..."
26 . D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
27 . I $G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
28 ; -- If DC NOT created or designated on previous run, designate:
29 I '$G(^XTMP("TIU169",1,"DONE")) D Q:$G(TIUQUIT)
30 . S DESDC=$$DESGNATE^TIUEN169
31 . I +DESDC=-1 W !,"Try later." S TIUQUIT=1 Q
32 . D TIUDUPS^TIUEN169(.TIUDUPS,+DESDC)
33 . I +$G(TIUDUPS("NOTINDC")) D LISTDUPS^TIUEN169(.TIUDUPS,0) S TIUQUIT=1 Q
34 . ; -- User has not designated a DC:
35 . I +DESDC=0 D Q:$G(TIUQUIT)
36 . . S TIUY=$$READ^TIUU("YO","I will create a new Document Class with new Titles under it. OK","YES")
37 . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
38 . ; -- No matching titles in Des DC:
39 . I +DESDC>0,'$G(TIUDUPS("INDC")) D Q:$G(TIUQUIT)
40 . . S TIUY=$$READ^TIUU("YO","I will create the new Titles under Document Class "_$P(DESDC,U,2)_". OK","YES")
41 . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
42 . ; -- Matching titles in Des DC:
43 . I +DESDC>0,+$G(TIUDUPS("INDC")) D Q:$G(TIUQUIT)
44 . . D LISTDUPS^TIUEN169(.TIUDUPS,1)
45 . . 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")
46 . . I +TIUY'=1 W !,"OK, try again when you're ready." S TIUQUIT=1
47 . ; -- If user has designated DC and agreed, change Name & set DONE node:
48 . I +DESDC>0 D
49 . . 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
50 . . S ^XTMP("TIU169",1,"DONE")=+DESDC
51 ; -- If DDEFs are being skipped, set their DONE nodes:
52 N NUM,ALLFLG S ALLFLG=1
53 F NUM=2:1:58 D
54 . I '$G(TIUDUPS("INDC",NUM)),'$D(^XTMP("TIU169",NUM,"DONE")) S ALLFLG=0 Q
55 . I $G(TIUDUPS("INDC",NUM)) S ^XTMP("TIU169",NUM,"DONE")=TIUDUPS("INDC",NUM)
56 I ALLFLG S ^XTMP("TIU169","DONE")="ALL" D Q
57 . W !,"All Document Definitions have already been created."
58 W ! K IOP N %ZIS S %ZIS="Q" D ^%ZIS
59 I POP W !,"Nothing created." K POP Q
60 I $D(IO("Q")) K IO("Q") D Q
61 .S ZTRTN="MAIN^TIUPS169"
62 .S ZTDESC="Create DDEFS for C&P Worksheets - TIU*1*169"
63 .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
64 .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
65 .D HOME^%ZIS
66 U IO D MAIN,^%ZISC
67 Q
68 ;
69MAIN ; Create DDEFS for C&P
70 N TMPCNT,TIUSTTS
71 K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J)
72 ; -- Begin message array ^TMP("TIU169MSG",$J:
73 S TMPCNT=0
74 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" ***** Document Definitions (DDEFS) for C&P Worksheets *****"
75 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Creating the Document Definitions..."
76 ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
77 ; of array ^TMP("TIU169":
78 D SETDATA^TIU169D
79 ; -- Loop through DDEFS to create them:
80 N NUM
81 F NUM=1:1:58 D
82 . N TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
83 . ; -- If DDEF was previously created by this option, or is being
84 . ; skipped, quit and get next DDEF:
85 . S TIUIEN=+$G(^XTMP("TIU169",NUM,"DONE")) Q:TIUIEN
86 . ; -- If not, create new DDEF:
87 . S YDDEF=$$CREATE(NUM)
88 . ; -- If DDEF couldn't be created or was found by lookup
89 . ; instead of being created, quit and get next DDEF:
90 . I $G(^TMP("TIU169ERR",$J,NUM))="CREATE" Q
91 . S TIUDA=+YDDEF
92 . ; -- Call FILE to stuff fields from ^TMP("TIU169",$J,"FILEDATA",NUM:
93 . D FILE(NUM,TIUDA)
94 . I $G(^TMP("TIU169ERR",$J,NUM))="FILE" D DELETE^TIU169D(TIUDA) Q
95 . ; -- Add item to parent, stuff item data:
96 . S PIEN=$$PARENT(NUM)
97 . I $G(^TMP("TIU169ERR",$J,NUM))="FINDPARENT" D DELETE^TIU169D(TIUDA) Q
98 . S ITEMDA=+$$ADDITEM^TIU169D(NUM,TIUDA,PIEN)
99 . I $G(^TMP("TIU169ERR",$J,NUM))="ADDITEM" D DELETE^TIU169D(TIUDA) Q
100 . D FILEITEM^TIU169D(NUM,PIEN,ITEMDA)
101 . I $G(^TMP("TIU169ERR",$J,NUM))="FILEITEM" D DELETE^TIU169D(TIUDA,PIEN,ITEMDA) Q
102 . ; -- DDEF NUM has been created and edited successfully:
103 . S ^XTMP("TIU169",NUM,"DONE")=TIUDA
104 . Q
105 ; -- Add results from CREATE loop to message array:
106 N NUM S NUM=0
107 I $O(^TMP("TIU169ERR",$J,NUM))="" D G MAINX
108 . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="All Document Definitions have now been created successfully."
109 . S ^XTMP("TIU169","DONE")="ALL"
110 . ; -- Kill indiv DONE nodes:
111 . N NUMBER F NUMBER=1:1:58 K ^XTMP("TIU169",NUMBER)
112 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
113 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Problems were encountered creating the following Document Definitions:"
114 F S NUM=$O(^TMP("TIU169ERR",$J,NUM)) Q:NUM="" D
115 . N PROB S PROB=^TMP("TIU169ERR",$J,NUM)
116 . D
117 . . I PROB="CREATE" S PROB="Couldn't create DDEF." Q
118 . . I PROB="FILE" S PROB="Couldn't file fields. DDEF deleted." Q
119 . . I PROB="FINDPARENT" S PROB="Couldn't find parent. DDEF deleted." Q
120 . . I PROB="ADDITEM" S PROB="Couldn't add DDEF to parent. DDEF deleted."
121 . . I PROB="FILEITEM" S PROB="Couldn't file Menu Text. DDEF deleted."
122 . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=$S(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU169",$J,"BASICS",NUM,"NAME")_": "
123 . S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" "_PROB
124 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
125 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
126 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)="come back and rerun the option."
127MAINX ; Exit
128 ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
129 ; now in case modules are run separately for debugging:
130 K TIUIERR,^TMP("DIERR",$J)
131 ; -- Finish message array ^TMP("TIU169MSG",$J and print it:
132 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=""
133 S TMPCNT=TMPCNT+1,^TMP("TIU169MSG",$J,TMPCNT)=" *************"
134 D PRINT^TIU169D
135 K ^TMP("TIU169MSG",$J),^TMP("TIU169ERR",$J),^TMP("TIU169",$J)
136 Q
137 ;
138PARENT(NUM) ; Return IEN of parent new DDEF should be added to
139 N PIEN,PNUM
140 ; Parent node has form:
141 ; ^TMP("TIU169",$J,"DATA",NUM,PIEN) = IEN of parent if known, or
142 ; ^TMP("TIU169",$J,"DATA",NUM,PNUM) = DDEF# of parent if not
143 S PIEN=$G(^TMP("TIU169",$J,"DATA",NUM,"PIEN"))
144 ; -- If parent IEN is known, we're done:
145 I +PIEN G PARENTX
146 ; -- If not, get DDEF# of parent
147 S PNUM=+$G(^TMP("TIU169",$J,"DATA",NUM,"PNUM"))
148 ; -- Get Parent IEN from "DONE" node, which was set
149 ; when parent was created:
150 S PIEN=+$G(^XTMP("TIU169",PNUM,"DONE"))
151PARENTX I 'PIEN!'$D(^TIU(8925.1,PIEN,0)) D
152 . S ^TMP("TIU169ERR",$J,NUM)="FINDPARENT"
153 Q PIEN
154 ;
155FILE(NUM,TIUDA) ; File fields for new DDEF TIUDA
156 ; Files ALL FIELDS set in "FILEDATA" nodes of ^TMP:
157 ; ^TMP("TIU169",$J,"FILEDATA",NUM,Field#)
158 N TIUFPRIV,FDA
159 K ^TMP("DIERR",$J)
160 S TIUFPRIV=1
161 M FDA(8925.1,TIUDA_",")=^TMP("TIU169",$J,"FILEDATA",NUM)
162 D FILE^DIE("TE","FDA")
163 I $D(^TMP("DIERR",$J)) S ^TMP("TIU169ERR",$J,NUM)="FILE"
164 Q
165 ;
166CREATE(NUM) ; Create new DDEF entry
167 N DIC,DLAYGO,DA,X,Y
168 S DIC="^TIU(8925.1,",DLAYGO=8925.1
169 S DIC(0)="LX",X=^TMP("TIU169",$J,"BASICS",NUM,"NAME")
170 S DIC("S")="I $P(^(0),U,4)="_""""_^TMP("TIU169",$J,"BASICS",NUM,"INTTYPE")_""""
171 D ^DIC
172 I $P($G(Y),U,3)'=1 S ^TMP("TIU169ERR",$J,NUM)="CREATE"
173 Q $G(Y)
Note: See TracBrowser for help on using the repository browser.