source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUHSV.m@ 949

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

initial load of WorldVistAEHR

File size: 3.8 KB
RevLine 
[613]1TIUHSV ;;SLC/AJB,AGP Edit Menu for TIUHS Routines;10/25/02
2 ;;1.0;TEXT INTEGRATION UTILITIES;**135**;Jun 20, 1997
3EN(IEN) ; -- main entry point for TIUHSLSV
4 N MSG
5 K ^TMP("VALMAR",$J)
6 D EN^VALM("TIUHSLSV")
7 Q
8 ;
9HDR ; -- header code
10 N CENTER,HEADER,OBJNAME,OBJNODE,TITLE,VALMHDR
11 S OBJNODE=^TIU(8925.1,IEN,0)
12 S OBJNAME=$P($G(OBJNODE),U)
13 S TITLE="Detailed Display/Edit for "_OBJNAME
14 S CENTER=(IOM-$L(TITLE))/2
15 S HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$L(TITLE))
16 S VALMHDR(1)=HEADER
17 Q
18 ;
19INIT ; -- init variables and list array
20 N ANS,CNT,DISP,HSONAME,HSTNAME,HSTYPE,LINE
21 N NUM,OBJMETD,OBJNAME,OBJNODE,OBJSTAT,OWNER
22 S OBJNODE=^TIU(8925.1,IEN,0)
23 S OBJSTAT=$S($P($G(OBJNODE),U,7)=11:"ACTIVE",$P($G(OBJNODE),U,7)=13:"INACTIVE")
24 S OBJNAME=$P($G(OBJNODE),U)
25 S OBJMETD=^TIU(8925.1,IEN,9)
26 S OWNER=$$GET1^DIQ(200,$P($G(OBJNODE),U,5),.01)
27 I OWNER="" S OWNER="<UNKNOWN> OR 0"
28 S HSOBJ=$P($P($G(OBJMETD),",",2),")")
29 I $G(HSOBJ)'=""&($D(^GMT(142.5,HSOBJ))>0) D
30 . S HSONAME=$$GET1^DIQ(142.5,HSOBJ,.01)
31 . S HSTYPE=$P($G(^GMT(142.5,HSOBJ,0)),U,3)
32 . I $G(HSTYPE)'=""&($D(^GMT(142,HSTYPE))>0) S HSTNAME=$$GET1^DIQ(142,HSTYPE,.01)
33 . E S HSTNAME="Invalid Health Summary Type IEN"
34 E S HSONAME="Invalid Health Summary Object IEN",HSTNAME="Invalid Health Summary Type IEN"
35 S HSTYPE=$P($G(^GMT(142.5,HSOBJ,0)),U,3)
36 ;
37 ;
38 S LINE=1
39 S DISP=""
40 D SET^VALM10(LINE,DISP)
41 F CNT=1:1:6 D
42 .S LINE=LINE+1
43 .S DISP=$P($T(OUTPUT+CNT),";;",2)
44 .S ANS=$S(CNT=1:OBJNAME,CNT=2:OWNER,CNT=3:OBJSTAT,CNT=4:HSONAME,CNT=5:HSTNAME,CNT=6:OBJMETD)
45 .S DISP=($J(DISP,25))_" "_ANS
46 .D SET^VALM10(LINE,DISP)
47 S VALMCNT=LINE
48 Q
49OUTPUT ;
50 ;;TIU Object Name:
51 ;;Owner:
52 ;;Status:
53 ;;HS Object:
54 ;;HS Type:
55 ;;Technical Field:
56 ;
57TIUN ;
58 D FULL^VALM1
59 D EDIT^TIUHSOBJ(IEN)
60 D CLEAN^VALM10
61 D INIT
62 Q
63 ;
64HSEDIT ;
65 N DIC,DIR,DIR,DIROUT,DTOUT,DUOUT,HIEN,POP,TEXT,X,Y,YESNO
66 D FULL^VALM1
67 I DUZ'=$P($G(^TIU(8925.1,IEN,0)),U,5) W !,"Can't edit this TIU Object: Only the owner can edit this TIU Object" H 2 Q
68 W !,"***WARNING***",!,"Changing the HS Object will change the output data and may change the HS Type."
69 S DIR(0)="YA0"
70 S DIR("A")="Continue? "
71 S DIR("B")="NO"
72 S DIR("?")="Enter Y or N. For detailed help type ??"
73 D ^DIR
74 I $D(DIROUT) S DTOUT=1
75 I $D(DTOUT)!($D(DUOUT)) Q
76 S YESNO=$E(Y(0))
77 I YESNO="Y" D
78 .S DIC=142.5,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY OBJECT: "
79 .W ! D ^DIC
80 .I Y=-1 K DIC Q
81 .S HIEN=+Y
82 .S ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HIEN_")"
83 D CLEAN^VALM10
84 D INIT
85 Q
86 ;
87CHHST ;
88 N DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
89 I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this National Object." H 2 Q
90 I $P($G(^GMT(142.5,HSOBJ,0)),U,17)'=DUZ W !,"Can't edit this HS object: Only the owner can edit this HS object." H 2 Q
91 W !,"***WARNING*** Changing the HS Type will change the output data."
92 S DIR(0)="YA0"
93 S DIR("A")="Continue? "
94 S DIR("B")="NO"
95 S DIR("?")="Enter Y or N. For detailed help type ??"
96 D ^DIR
97 I $D(DIROUT) S DTOUT=1
98 I $D(DTOUT)!($D(DUOUT)) Q
99 S YESNO=$E(Y(0))
100 I YESNO="Y" D
101 .S DIC=142,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY TYPE: "
102 .W ! D ^DIC
103 .I Y=-1 K DIC Q
104 .S HSIEN=+Y
105 .S DIE="^GMT(142.5,",DA=HSOBJ,DR=".03///^S X=HSIEN" D ^DIE
106 D CLEAN^VALM10
107 D INIT
108 Q
109 ;
110HSOBJ ;
111 D FULL^VALM1
112 N HSTYNAM,YESNO
113 S YESNO="Y"
114 I $D(^GMT(142.5,HSOBJ,0))=0 D
115 . W !,"No HS Object found. Create new HS Object now?"
116 . S DIR(0)="YA0"
117 . S DIR("B")="NO"
118 . S DIR("?")="Enter Y or N. For detailed help type ??"
119 . D ^DIR
120 . I $D(DIROUT) S DTOUT=1
121 . I $D(DTOUT)!($D(DUOUT)) S YESNO="N" Q
122 . S YESNO=$E(Y(0))
123 . I YESNO="Y" S HSOBJ=$$CRE^GMTSOBJ()
124 I $G(YESNO)="Y"&(HSOBJ>0) D
125 . S ^TIU(8925.1,IEN,9)="S X=$$TIU^GMTSOBJ(DFN,"_HSOBJ_")"
126 . D EN^TIUHSOLM(HSOBJ,IEN)
127 D CLEAN^VALM10
128 D INIT
129 Q
130 ;
131HELP ; -- help code
132 N X
133 S X="?" D DISP^XQORM1 W !!
134 Q
135 ;
136EXIT ; -- exit code
137 Q
138 ;
139EXPND ; -- expand code
140 Q
141 ;
Note: See TracBrowser for help on using the repository browser.