source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIU182DF.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: 6.6 KB
RevLine 
[613]1TIU182DF ; SLC/MAM - Create new HP DDEFS ; 7/22/04
2 ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
3 ; Run this after installing patch 182.
4 ;Use option: TIU182 DDEFS, MED CONVERSION
5 ; External References
6 ; DBIA 3409 ^USR(8930,"B"
7BEGIN ; Create DDEFS
8 W !!,"This option creates Historical Procedure Document Definitions (DDEFS) for",!,"the Medicine Package conversion."
9 W !,"It may take one or two minutes to run. It will tell you whether or not",!,"it is successful."
10 W ! K IOP N %ZIS S %ZIS="Q" D ^%ZIS I POP K POP Q
11 I $D(IO("Q")) K IO("Q") D Q
12 .S ZTRTN="MAIN^TIUPS182"
13 .S ZTDESC="Create DDEFS for Medicine Conversion - TIU*1*182"
14 .D ^%ZTLOAD W !,$S($D(ZTSK):"Request Queued!",1:"Request Canceled!")
15 .K ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE
16 .D HOME^%ZIS
17 U IO D MAIN,^%ZISC
18 Q
19 ;
20MAIN ; Create Historical Procedure DDEFS for Medicine Conversion
21 N TIUDUPS,TMPCNT,TIUSTTS
22 ; -- Set ^XTMP deletion date for about 2 years hence:
23 ; Set it even if all are already created, in case it's in test
24 ; for more than 2 years, so sites can reset it by running option.
25 S ^XTMP("TIU182",0)=$$FMADD^XLFDT(DT,730)_U_DT_U_"Tracks DDEFS created by Option TIU182 DDEFS, MED CONVERSION"
26 K ^TMP("TIU182MSG",$J),^TMP("TIU182ERR",$J),^TMP("TIU182",$J)
27 ; -- Begin message array ^TMP("TIU182MSG",$J:
28 S TMPCNT=0
29 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="*** Historical Procedure Document Definitions for the Medicine Conversion ***"
30 ; -- Check if ALL done; check for Class Clinical Coord:
31 I $G(^XTMP("TIU182","DONE"))="ALL" D G MAINX
32 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="All DDEFS exported for the conversion have already been created"
33 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="by option TIU182 DDEFS, MED CONVERSION."
34 N CPCLASS S CPCLASS=$$CLASS^TIUCP I 'CPCLASS D
35 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109."
36 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Option cannot be run without it."
37 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
38 I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" D
39 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I can't find User Class CLINICAL COORDINATOR. Option cannot be run without it."
40 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
41 ; -- Set basic DDEF data into BASICS node of data array ^TMP("TIU182":
42 D SETBASIC^TIUEN182
43 ; -- Check for potential DDEF duplicates at site:
44 D TIUDUPS^TIUEN182(.TIUDUPS,1)
45 ; -- If potential duplicates exist, add them to message array:
46 I TIUDUPS D LISTDUPS^TIUEN182(.TIUDUPS,.TMPCNT,1) G MAINX
47 I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" G MAINX
48 I 'CPCLASS G MAINX
49 ; -- If no potential dups, User Class exists, CLINICAL PROCEDURES
50 ; Class exists, go on:
51 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Environment looks OK."
52 ; -- Check if some DDEFS done:
53 I $G(^XTMP("TIU182","DONE"))="SOME" D
54 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Some of the DDEFS exported for the conversion have already been"
55 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="created by this option. I will now create the others..."
56 ; -- If none created yet:
57 I '$D(^XTMP("TIU182","DONE")) D
58 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Creating the Document Definitions..."
59 ; -- Set flds for FILE call & item data into nodes FILEDATA & DATA
60 ; of array ^TMP("TIU182":
61 D SETDATA^TIU182D
62 ; -- Loop through DDEFS to create them:
63 N NUM
64 F NUM=1:1:13 D
65 . N TIUIEN,YDDEF,TIUDA,PIEN,ITEMDA
66 . ; -- If DDEF was previously created by this option,
67 . ; quit and get next DDEF:
68 . S TIUIEN=+$G(^XTMP("TIU182",NUM,"DONE")) Q:TIUIEN
69 . ; -- If not, create new DDEF:
70 . S YDDEF=$$CREATE^TIU182D1(NUM)
71 . ; -- If DDEF couldn't be created or was found by lookup
72 . ; instead of being created, quit and get next DDEF:
73 . I $G(^TMP("TIU182ERR",$J,NUM))="CREATE" Q
74 . S TIUDA=+YDDEF
75 . ; -- Call FILE to stuff fields from ^TMP("TIU182",$J,"FILEDATA",NUM:
76 . D FILE^TIU182D1(NUM,TIUDA)
77 . I $G(^TMP("TIU182ERR",$J,NUM))="FILE" D DELETE^TIU182D1(TIUDA) Q
78 . ; -- Add item to parent, stuff item data:
79 . S PIEN=$$PARENT^TIU182D1(NUM)
80 . I $G(^TMP("TIU182ERR",$J,NUM))="FINDPARENT" D DELETE^TIU182D1(TIUDA) Q
81 . S ITEMDA=+$$ADDITEM^TIU182D1(NUM,TIUDA,PIEN)
82 . I $G(^TMP("TIU182ERR",$J,NUM))="ADDITEM" D DELETE^TIU182D1(TIUDA) Q
83 . D FILEITEM^TIU182D1(NUM,PIEN,ITEMDA)
84 . I $G(^TMP("TIU182ERR",$J,NUM))="FILEITEM" D DELETE^TIU182D1(TIUDA,PIEN,ITEMDA) Q
85 . ; -- DDEF NUM has been created and edited successfully:
86 . S ^XTMP("TIU182",NUM,"DONE")=TIUDA
87 . S ^XTMP("TIU182","DONE")="SOME"
88 . Q
89 ; -- Add results from CREATE loop to message array:
90 N NUM S NUM=0
91 I $O(^TMP("TIU182ERR",$J,NUM))="" D G MAINX
92 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="All Document Definitions have now been created successfully."
93 . S ^XTMP("TIU182","DONE")="ALL"
94 . ; -- Kill indiv DONE nodes:
95 . N NUMBER F NUMBER=1:1:13 K ^XTMP("TIU182",NUMBER)
96 . ; -- Edit Print Form Header,delete PF Number of Class CP:
97 . N FDA,TIUFPRIV S FDA(8925.1,CPCLASS_",",6.1)="CLINICAL PROCEDURES"
98 . S FDA(8925.1,CPCLASS_",",6.12)="@"
99 . S TIUFPRIV=1
100 . D FILE^DIE("TE","FDA")
101 . Q:'$D(^TMP("DIERR",$J))
102 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Couldn't update CP Print Fields. See patch description or contact EVS."
103 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
104 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Problems were encountered creating the following Document Definitions:"
105 F S NUM=$O(^TMP("TIU182ERR",$J,NUM)) Q:NUM="" D
106 . N PROB S PROB=^TMP("TIU182ERR",$J,NUM)
107 . D
108 . . I PROB="CREATE" S PROB="Couldn't create DDEF." Q
109 . . I PROB="FILE" S PROB="Couldn't file fields. DDEF deleted." Q
110 . . I PROB="FINDPARENT" S PROB="Couldn't find parent. DDEF deleted." Q
111 . . I PROB="ADDITEM" S PROB="Couldn't add DDEF to parent. DDEF deleted."
112 . . I PROB="FILEITEM" S PROB="Couldn't file Menu Text. DDEF deleted."
113 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=$S(NUM=1:"Document Class ",1:"Title ")_^TMP("TIU182",$J,"BASICS",NUM,"NAME")_": "
114 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" "_PROB
115 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
116 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="Please contact Enterprise VistA Support. When problems have been resolved,"
117 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="come back and rerun the option."
118MAINX ; Exit
119 ; -- Leave latest error arrays ^TMP("DIERR",$J) & TIUIERR around until
120 ; now in case modules are run separately for debugging:
121 K TIUIERR,^TMP("DIERR",$J)
122 ; -- Finish message array ^TMP("TIU182MSG",$J and print it:
123 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
124 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" *************"
125 D PRINT^TIU182D
126 K ^TMP("TIU182MSG",$J),^TMP("TIU182ERR",$J),^TMP("TIU182",$J)
127 Q
Note: See TracBrowser for help on using the repository browser.