source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUWRII1.m@ 1006

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

initial load of WorldVistAEHR
File size: 4.8 KB
RevLine 
[613]1TIUWRII1 ;SLC/AJB,AGP - War Related Illness and Injury Study Center ; 08/18/03
2 ;;1.0;TEXT INTEGRATION UTILITIES;**159**;Jun 20, 1997
3 ;
4 Q
5EN ;
6 X ^%ZOSF("EON") W $G(IOCUON),@IOF
7 N FDA,FDAIEN,MSG,POP,TIUABORT,TIUDA,TIUFPRIV,TIUPRNT
8 S TIUFPRIV=1,TIUPRNT=0
9 I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) F D Q:TIUPRNT>0!($D(DUOUT))
10 . D GETCLASS
11 . I +TIUPRNT<0 W !!,"Installation Error: Invalid Selection.",!
12 I +TIUPRNT<0 W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",! H 1 Q
13 I $$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")>0,'$$PATCH^XPDUTL("TIU*1.0*159") W !!,"Installation Error: WRIISC Assessment Note already exists.",! Q
14 I $$CHKTITLE(8930,"CLINICAL COORDINATOR")<0 W !!,"Installation Error: Class owner cannot be defined.",! Q
15 D DELOBJS,MKOBJS I $G(TIUABORT)>0 D DELOBJS H 2 Q
16 I '$$PATCH^XPDUTL("TIU*1.0*159")!($$CHKTITLE(8925.1,"WRIISC ASSESSMENT NOTE")=-1) D
17 . S FDA(8925.1,"+1,",.01)="WRIISC ASSESSMENT NOTE"
18 . S FDA(8925.1,"+1,",.03)="WRIISC ASSESSMENT NOTE"
19 . S FDA(8925.1,"+1,",.04)="DOC"
20 . S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
21 . S FDA(8925.1,"+1,",.07)=11
22 . S FDA(8925.1,"+1,",3.02)=1
23 . S FDA(8925.1,"+1,",99)=$H
24 . D UPDATE^DIE("","FDA","FDAIEN","MSG")
25 . I $D(MSG) D D DELOBJS Q
26 .. W !!,"The following error message was returned:",!!
27 .. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
28 . W !!,"Creation of WRIISC ASSESSMENT NOTE title successful...",! H 1
29 . S TIUDA=FDAIEN(1)
30 . S FDA(8925.14,"+2,"_TIUPRNT_",",.01)=FDAIEN(1)
31 . S FDA(8925.14,"+2,"_TIUPRNT_",",4)="WRIISC Assessment Note"
32 . D UPDATE^DIE("","FDA","FDAIEN","MSG")
33 . I $D(MSG) D Q
34 .. W !!,"The following error message was returned:",!!
35 .. S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
36 . W !,"Addition of "_$P(^TIU(8925.1,TIUPRNT,0),U)_" as parent successful...",! H 1
37 W !,"Update finished."
38 D
39 .N DIR,X,Y
40 .S DIR(0)="E"
41 .W ! D ^DIR
42 Q
43CHKTITLE(FILE,NAME) ;
44 N DIC,X,Y
45 S DIC=FILE,DIC(0)="X"
46 S X=NAME
47 D ^DIC
48 Q +Y
49GETCLASS ;
50 N DIC,X,Y
51 S DIC("A")="Select the DOCUMENT CLASS where the new title will be installed: "
52 S DIC(0)="AEQ",DIC="^TIU(8925.1,",DIC("S")="I $P(^(0),U,4)=""DC"""
53 D ^DIC
54 S TIUPRNT=+Y
55 Q
56GETLAB ;
57 N DIC,X,Y
58 S DIC("A")="Enter your site's local lab name for "_LABNAME_": "
59 S DIC(0)="AEQ",DIC="^LAB(60,"
60 W ! D ^DIC
61 S LABIEN=+Y S:LABIEN>0 LABNAME=$P(Y,U,2)
62 Q
63MKOBJS ;
64 N LABIEN,LABNAME,LINE,LINETXT,METHOD,NAME
65 F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM"!$G(TIUABORT)>0 D
66 .S NAME=$P(LINETXT,";"),METHOD=$P(LINETXT,";",2)
67 .S:METHOD["@" METHOD=$TR(METHOD,"@",";")
68 .I $$CHKTITLE(8925.1,NAME)>0 W !!,"Installation Error: TIU Object "_NAME_" already exists." H 1 Q
69 .I METHOD="ASK USER" D
70 ..N DUOUT,FLAG S FLAG=0
71 ..S LABNAME=$P(LINETXT,";",3)
72 ..I LABNAME="HEPATITIS C ANTIBODY" S FLAG=1
73 ..S LABIEN=0
74 ..F Q:LABIEN>0!($D(DUOUT)) D GETLAB
75 ..S:LABIEN>0 METHOD=$S(FLAG=1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,,1410102,$$NOW^XLFDT)",1:"S X=$$LAB2^TIUWRIIS(DFN,"""_LABNAME_""",5,""T-365"")")
76 .I METHOD="ASK USER" D S TIUABORT=1 Q
77 ..W !!,"Installation Error: TIU Object "_NAME_" creation aborted by user."
78 ..W !,"Enter EN^TIUWRII1 at the programmer prompt to re-build note title and objects.",!
79 ..W !,"See the patch description for more details."
80 .I $$MKOBJ(NAME,METHOD)<0 D
81 ..W !!,"Installation Error: Creation of TIU Object "_NAME_" failed.",!
82 Q
83MKOBJ(NAME,METHOD) ;
84 N FDA,FDAIEN,MSG
85 S FDA(8925.1,"+1,",.01)=NAME
86 S FDA(8925.1,"+1,",.03)=NAME
87 S FDA(8925.1,"+1,",.04)="O"
88 S FDA(8925.1,"+1,",.06)=$$CHKTITLE(8930,"CLINICAL COORDINATOR")
89 S FDA(8925.1,"+1,",.07)=11
90 S FDA(8925.1,"+1,",9)=METHOD
91 S FDA(8925.1,"+1,",99)=$H
92 D UPDATE^DIE("","FDA","FDAIEN","MSG")
93 I $D(MSG) D Q -1
94 . W !!,"TIU Object creation failed. The following error message was returned:",!!
95 . S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
96 W !!,"Creation of TIU Object "_NAME_" successful..." H 1
97 Q 1
98DELOBJS ;
99 N DA,DIK,LINE,LINETXT,NAME,X,Y
100 F LINE=1:1 S LINETXT=$P($T(DATA+LINE),";;",2) Q:LINETXT="EOM" D
101 .S NAME=$P(LINETXT,";")
102 .S DA=0,DA=$O(^TIU(8925.1,"B",NAME,DA))
103 .S DIK="^TIU(8925.1,"
104 .I DA>0 D ^DIK
105 Q
106DATA ;
107 ;;VA-WRIISC ADDRESS;S X=$$ADDRESS^TIUWRIIS(DFN)
108 ;;VA-WRIISC ACTIVE PROBLEMS;S X=$$PROB^TIUWRIIS(DFN)
109 ;;VA-WRIISC NEXT OF KIN;S X=$$PNOK^TIUWRIIS(DFN)
110 ;;VA-WRIISC VITALS;S X=$$VITALS^TIUWRIIS(DFN,"T@BP@P@R",1,"T-90")
111 ;;VA-WRIISC CBC;ASK USER;CBC
112 ;;VA-WRIISC GLUCOSE;ASK USER;GLUCOSE
113 ;;VA-WRIISC HEMATOCRIT;ASK USER;HEMATOCRIT
114 ;;VA-WRIISC HEMOGLOBIN;ASK USER;HEMOGLOBIN
115 ;;VA-WRIISC HEPATITIS C ANTIBODY;ASK USER;HEPATITIS C ANTIBODY
116 ;;VA-WRIISC POTASSIUM;ASK USER;POTASSIUM
117 ;;VA-WRIISC SODIUM;ASK USER;SODIUM
118 ;;VA-WRIISC URINALYSIS;ASK USER;URINALYSIS
119 ;;EOM
120 Q
Note: See TracBrowser for help on using the repository browser.