source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUEN182.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: 4.9 KB
RevLine 
[613]1TIUEN182 ; SLC/MAM - Environment Check Rtn for TIU*1*182 ; 6/9/04
2 ;;1.0;Text Integration Utilities;**182**;Jun 20, 1997
3 ; External References
4 ; DBIA 3409 ^USR(8930,"B"
5MAIN ; Check environment. If problems found, warn but do not abort install.
6 ; -- Check if done:
7 I $G(^XTMP("TIU182","DONE"))="ALL" W !,"All Document Definitions exported for the Medicine Conversion have already",!," been created. You won't need to rerun the option." Q
8 I '$$CLASS^TIUCP W !,"I can't find Class CLINICAL PROCEDURES, exported in patch TIU*1*109. You",!,"won't be able to run the option that creates the Document Definitions",!,"without this class. See patch description.",!
9 I $O(^USR(8930,"B","CLINICAL COORDINATOR",""))="" W !,"I can't find User Class CLINICAL COORDINATOR. You won't be able to run",!,"the option that creates the Document Definitions without this class. See",!,"patch description.",!
10 ; -- Check for potential DDEF duplicates at site:
11 D SETBASIC ; Set basic data for DDEFS into ^TMP for dups check
12 W !,"Checking for potential duplicate Document Definitions..."
13 N TIUDUPS
14 D TIUDUPS(.TIUDUPS)
15 I 'TIUDUPS W !," No potential duplicates found.",!,"Remember to run option TIU182 DDEFS, MED CONVERSION after installing the patch." G MAINX
16 ; -- If potential duplicates exist, list them:
17 K ^TMP("TIU182MSG",$J) ; LISTDUPS needs new ^TMP("TIU182MSG",$J)
18 D LISTDUPS(.TIUDUPS,0,0)
19MAINX K ^TMP("TIU182MSG",$J) ; Clean up after LISTDUPS
20 K ^TMP("TIU182",$J) ; Clean up after SETBASIC
21 Q
22 ;
23SETBASIC ; Set up basic data in ^TMP("TIU182",$J,"BASICS")
24 N NUMBER
25 ; -- Set ^TMP("TIU182",$J,"BASICS",[NUMBER],["INTTYPE" or "NAME"])
26 ; -- Set basic data NAME and interior TYPE for new DDEFS into TMP.
27 ; Reference DDEFS by NUMBER.
28 ; Number parent-to-be BEFORE child.
29 ; Name MUST be upper case or ADDITEM fails
30 S ^TMP("TIU182",$J,"BASICS",1,"INTTYPE")="DC"
31 F NUMBER=2:1:13 S ^TMP("TIU182",$J,"BASICS",NUMBER,"INTTYPE")="DOC"
32 F NUMBER=1:1:13 S ^TMP("TIU182",$J,"BASICS",NUMBER,"NAME")=$P($T(NAME+NUMBER),";;",2,99)
33 Q
34 ;
35TIUDUPS(TIUDUPS,OPTFLG) ; Set array TIUDUPS of potential duplicate DDEFS
36 N NUM S TIUDUPS=0,OPTFLG=+$G(OPTFLG)
37 I $G(^XTMP("TIU182","DONE"))="ALL" Q
38 F NUM=1:1:13 Q:'NUM D
39 . ; -- When looking for duplicates, ignore DDEF if
40 . ; previously created by this patch:
41 . Q:$G(^XTMP("TIU182",NUM,"DONE"))
42 . ; -- If site already has DDEF w/ same Name & Type as one
43 . ; we are exporting, set its number into array TIUDUPS:
44 . N NAME,TYPE,TIUDA S TIUDA=0
45 . S NAME=^TMP("TIU182",$J,"BASICS",NUM,"NAME")
46 . S TYPE=^TMP("TIU182",$J,"BASICS",NUM,"INTTYPE")
47 . F S TIUDA=$O(^TIU(8925.1,"B",NAME,TIUDA)) Q:+TIUDA'>0 D
48 . . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)=TYPE S TIUDUPS(NUM)=+TIUDA,TIUDUPS=1
49 Q
50 ;
51LISTDUPS(TIUDUPS,TMPCNT,OPTFLG) ; List duplicates by name
52 ; TIUDUPS = array as set in TIUDUPS. Required.
53 ; TMPCNT = Count at which to start message array ^TMP("TIU182MSG",$J,TMPCNT); Received by reference. (Array already has some nodes if called from option.) Optional.
54 ; OPTFLG = 1 if called from option;
55 ; 0 if called from env check. Optional.
56 N NUM
57 S OPTFLG=+$G(OPTFLG)
58 S TMPCNT=$S($G(TMPCNT):TMPCNT,1:0)
59 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="You already have the following Document Definitions exported by this patch."
60 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="I don't want to overwrite them. Please change their names so they no longer"
61 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="match the exported ones, or if you are not using them, delete them. If you"
62 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="change the name of a Document Definition you plan to continue using, remember"
63 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="to update its Print Name, as well. For help, contact Enterprise VistA Support."
64 S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=""
65 S TMPCNT=TMPCNT+1
66 I 'OPTFLG D
67 . S ^TMP("TIU182MSG",$J,TMPCNT)="You will not be able to run option TIU182 DDEFS, MED CONVERSION to create the"
68 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)="DDEFS until these matches are eliminated."
69 E S ^TMP("TIU182MSG",$J,TMPCNT)="You may not run this option until these matches are eliminated."
70 S NUM=0
71 F S NUM=$O(TIUDUPS(NUM)) Q:'NUM D
72 . S TMPCNT=TMPCNT+1,^TMP("TIU182MSG",$J,TMPCNT)=" "_^TMP("TIU182",$J,"BASICS",NUM,"NAME")
73 ; -- If called from env check, not option, write list:
74 I OPTFLG Q
75 N TIUI S TIUI=0
76 F S TIUI=$O(^TMP("TIU182MSG",$J,TIUI)) Q:'TIUI D
77 . W !,^TMP("TIU182MSG",$J,TIUI)
78 Q
79 ;
80NAME ; Names of DDEFS in order from 1 to 13
81 ;;HISTORICAL PROCEDURES
82 ;;HISTORICAL CARDIAC CATHETERIZATION PROCEDURE
83 ;;HISTORICAL ELECTROCARDIOGRAM PROCEDURE
84 ;;HISTORICAL ECHOCARDIOGRAM PROCEDURE
85 ;;HISTORICAL ELECTROPHYSIOLOGY PROCEDURE
86 ;;HISTORICAL HOLTER PROCEDURE
87 ;;HISTORICAL EXERCISE TOLERANCE TEST PROCEDURE
88 ;;HISTORICAL PRE/POST SURGERY RISK NOTE
89 ;;HISTORICAL ENDOSCOPIC PROCEDURE
90 ;;HISTORICAL PULMONARY FUNCTION TEST PROCEDURE
91 ;;HISTORICAL HEMATOLOGY PROCEDURE
92 ;;HISTORICAL PACEMAKER IMPLANTATION PROCEDURE
93 ;;HISTORICAL RHEUMATOLOGY PROCEDURE
94 Q
Note: See TracBrowser for help on using the repository browser.