source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUHSOBJ.m

Last change on this file was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1TIUHSOBJ ;SLC/AJB,AGP - Health Summary to TIU Object; 10/28/02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**135**;Jun 20, 1997
3 ;
4 Q
5 ;
6CREATE ; create a TIU object
7 ;
8 N TIUDA,TIUHS,TIUKF,TIUNAME
9 N DA,DIC,DIK,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
10 ;
11 W @IOF
12 W !?19,"--- Create TIU/Health Summary Object ---"
13 ;
14 S DIR(0)="FAO^3:54"
15 S DIR("A")="Enter a New TIU OBJECT NAME: "
16 S DIR("?",1)="This is the technical name, 3-54* characters, not starting with punctuation."
17 S DIR("?",2)="Name must be unique among all object Names, Abbreviations, and Print Names."
18 S DIR("?",3)="Any lower case characters will automatically be changed to uppercase."
19 S DIR("?",4)=""
20 S DIR("?")="* "" (TIU)"" will be appended to the name entered to differentiate how the object was created. Example: OBJECT becomes OBJECT (TIU)"
21 ;
22 F Q:$G(TIUDA)=0 W ! D ^DIR S X=$$UP^XLFSTR(X) D:'$D(DIRUT) I $D(DIRUT) W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S DIRUT="" Q
23 . S TIUDA=$$FIND1^DIC(8925.1,"","AMX",X,"D^C^B","I $P(^TIU(8925.1,+Y,0),U,4)=""O""","ERR")
24 . I TIUDA'=0 W !!,"The object name ",X," already exists." K X,Y,TIUDA Q
25 . I ($A($E(X,1))'<48&($A($E(X,1))'>57))!($A($E(X,1))'<65&($A($E(X,1))'>90))!($A($E(X,1))=32)
26 . E W !!,DIR("?",1) K TIUDA,X,Y Q
27 . W !!,"Object Name: ",X D
28 . . N DIR,X,Y S DIR("A")="Is this correct",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
29 . . Q:$D(DIRUT) I Y(0)="NO" K TIUDA
30 Q:$D(DIRUT)
31 ;
32 S TIUKF=0,TIUNAME=X K DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
33 ;
34 D I $D(DIRUT) W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR Q
35 . N DIR
36 . S DIR("A")="Use a pre-existing Health Summary Object",DIR(0)="Y",DIR("B")="NO" W ! D ^DIR
37 I $G(Y(0))="NO"
38 E G PE
39 ;
40 W !!,"Checking ",TIUNAME_" (TIU)"," with Health Summary..."
41 I $$FIND1^DIC(142.5,,"BX",TIUNAME_" (TIU)","B",,"ERROR")=0 D
42 . W ! S TIUHS=$$CRE^GMTSOBJ(TIUNAME_" (TIU)") S TIUKF=1
43 I D Q:$G(Y)=-1
44 . I TIUHS=-1 W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S Y=-1 Q
45 E H .5 W "that name already exists."
46PE ;
47 E D Q:$G(Y)=-1
48 . S DIC=142.5,DIC("A")="Enter the name of the Health Summary Object: "
49 . S DIC(0)="AEMQ",DIC("S")="I Y'<1"
50 . W ! D ^DIC I Y=-1 W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR S Y=-1 Q
51 . S TIUHS=+Y K DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
52 ;
53 W !!,"Create a TIU Object named: ",TIUNAME ; ,"/",$$GET1^DIQ(142.5,TIUHS_",",.01)
54 S DIR("A")="Ok",DIR(0)="Y",DIR("B")="YES" W ! D ^DIR
55 I $G(Y(0))'="YES" D Q
56 . I TIUKF=1 S DA=TIUHS,DIK="^GMT(142.5," D ^DIK
57 . W ! K DIR S DIR("A")="Enter RETURN to abort TIU Object creation...",DIR(0)="EA" D ^DIR
58 ;
59 N FDA,FDAIEN,MSG
60 S FDA(8925.1,"+1,",.01)=TIUNAME
61 S FDA(8925.1,"+1,",.03)=TIUNAME
62 S FDA(8925.1,"+1,",.04)="O"
63 S FDA(8925.1,"+1,",.05)=DUZ
64 S FDA(8925.1,"+1,",.07)="11"
65 S FDA(8925.1,"+1,",9)="S X=$$TIU^GMTSOBJ(DFN,"_TIUHS_")"
66 S FDA(8925.1,"+1,",99)=$H
67 ;
68 D UPDATE^DIE("","FDA","FDAIEN","MSG")
69 ;
70 I $D(MSG) D Q
71 . W !!,"TIU Object creation failed. The following error message was returned:",!!
72 . S MSG="" F S MSG=$O(MSG("DIERR",1,"TEXT",MSG)) Q:MSG="" W MSG("DIERR",1,"TEXT",MSG),!
73 ;
74 W !!,"TIU Object created successfully.",! K DIR S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" D ^DIR
75 Q
76 ;
77EDIT(TIUDA) ;
78 ;
79 Q:$G(TIUDA)'>0
80 Q:$D(^TIU(8925.1,TIUDA,0))'>0
81 N DA,DIE,DIR,DR,X,Y
82 I $G(DUZ)'=$P($G(^TIU(8925.1,TIUDA,0)),U,5) D Q
83 . W !!,"You are not the owner - cannot edit name!"
84 . S DIR("A")="Enter RETURN to continue...",DIR(0)="EA" W ! D ^DIR
85 S DA=TIUDA,DIE="^TIU(8925.1,",DR=".01//"
86 D ^DIE
87 Q
88 ;
89EXIST(HSNUM) ; entry point for Health Summary to verify if a HS Object is used in a TIU Object
90 ;
91 N EXIST,TIUDA S (EXIST,TIUDA)=0
92 F S TIUDA=$O(^TIU(8925.1,TIUDA)) Q:TIUDA="" I +$P($G(^TIU(8925.1,TIUDA,9)),",",2)=HSNUM S EXIST=1
93 Q EXIST
Note: See TracBrowser for help on using the repository browser.