source: FOIAVistA/tag/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUHSOLM.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.2 KB
Line 
1TIUHSOLM ;;SLC/AJB,AGP Display Health Summary Object for TIU Objects;22-OCT-2002
2 ;;1.0;TEXT INTEGRATION UTILITIES;**135**;Jun 20, 1997
3EN(IEN,TIUIEN) ; -- main entry point for TIUHS OBJ DISPLAY
4 D EN^VALM("TIUHS OBJ DISPLAY")
5 Q
6 ;
7HDR ; -- header code
8 N CENTER,HEADER,TIUNAM,HSOBJNOD,TITLE,VALHDR,VALMSG
9 ;S HSOBJNOD=$G(^GMT(142.5,IEN,0))
10 S TIUNAM=$P($G(^TIU(8925.1,TIUIEN,0)),U)
11 S TITLE="Detailed Display for "_TIUNAM
12 S CENTER=(IOM-$L(TITLE))/2
13 S HEADER=$$SETSTR^VALM1(TITLE,"",CENTER,$L(TITLE))
14 S VALMHDR(1)=HEADER
15 S VALMSG="?? More Actions"
16 D XQORM
17 Q
18 ;
19INIT ; -- init variables and list array
20 N LINE,OBJ,OBJDISP,OBJECT,VAL,VALUE
21 S LINE=0
22 ;hs object heading
23 D EXTRACT^GMTSOBJ(IEN,.OBJ)
24 S HSTYNAM=$G(OBJ(IEN,.03,"E"))
25 S VALUE=$J("HS Object",25)_": "_$G(OBJ(IEN,.01,"E")),LINE=LINE+1
26 D SET^VALM10(LINE,VALUE)
27 I $G(OBJ(IEN,.02,"E"))'="" D
28 . S VALUE=$J($G(OBJ(IEN,.02,"PROMPT")),25)_": "_$G(OBJ(IEN,.02,"E"))
29 . S LINE=LINE+1
30 . D SET^VALM10(LINE,VALUE)
31 S VALUE=$J($G(OBJ(IEN,.03,"PROMPT")),25)_": "_HSTYNAM,LINE=LINE+1
32 D SET^VALM10(LINE,VALUE)
33 S VALUE=$J($G(OBJ(IEN,.04,"PROMPT")),25)_": "_$G(OBJ(IEN,.04,"E")),LINE=LINE+1
34 D SET^VALM10(LINE,VALUE)
35 S VALUE=$J($G(OBJ(IEN,.17,"PROMPT")),25)_": "_$G(OBJ(IEN,.17,"E"))
36 S LINE=LINE+1
37 D SET^VALM10(LINE,VALUE)
38 S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
39 S OBJDISP="HS Object",CENTER=(IOM-$L(OBJDISP))/2
40 S VALUE=$$SETSTR^VALM1(OBJDISP,"",CENTER,$L(OBJDISP))
41 S LINE=LINE+1 D SET^VALM10(LINE,VALUE)
42 S VALUE=" ",LINE=LINE+1 D SET^VALM10(LINE,VALUE)
43 S VALUE=$J($G(OBJ(IEN,.07,"PROMPT")),29)_": "_$G(OBJ(IEN,.07,"E"))
44 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
45 S LINE=LINE+1
46 D SET^VALM10(LINE,VALUE)
47 S VALUE=$J($G(OBJ(IEN,.08,"PROMPT")),29)_": "_$G(OBJ(IEN,.08,"E"))
48 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.1,"PROMPT")),28)_": "_$G(OBJ(IEN,.1,"E"))
49 S LINE=LINE+1
50 D SET^VALM10(LINE,VALUE)
51 S VALUE=$J("Customized Header",29)_": "_$G(OBJ(IEN,.06,"E"))
52 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.09,"PROMPT")),28)_": "_$G(OBJ(IEN,.09,"E"))
53 S LINE=LINE+1
54 D SET^VALM10(LINE,VALUE)
55 S VALUE=$J($G(OBJ(IEN,.05,"PROMPT")),29)_": "_$G(OBJ(IEN,.05,"E"))
56 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.12,"PROMPT")),28)_": "_$G(OBJ(IEN,.12,"E"))
57 S LINE=LINE+1
58 D SET^VALM10(LINE,VALUE)
59 S VALUE=$J($G(OBJ(IEN,.16,"PROMPT")),29)_": "_$G(OBJ(IEN,.16,"E"))
60 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.14,"PROMPT")),28)_": "_$G(OBJ(IEN,.14,"E"))
61 S LINE=LINE+1
62 D SET^VALM10(LINE,VALUE)
63 S VALUE=$J($G(OBJ(IEN,.2,"PROMPT")),29)_": "_$G(OBJ(IEN,.2,"E"))
64 S VAL=$$LJ^XLFSTR(VALUE,40) S VALUE=VAL_$J($G(OBJ(IEN,.13,"PROMPT")),28)_": "_$G(OBJ(IEN,.13,"E"))
65 S LINE=LINE+1
66 D SET^VALM10(LINE,VALUE)
67 S VALUE=$$RJ^XLFSTR("Blank Line After Header",68)_": "_$G(OBJ(IEN,.15,"E"))
68 S LINE=LINE+1
69 D SET^VALM10(LINE,VALUE)
70 S VALMCNT=LINE
71 Q
72 ;
73EHSO ;
74 N HSOBNAM,VALUE
75 D FULL^VALM1
76 I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this HS Object: Only the owner can edit this HS Object" H 2 Q
77 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
78 S HSOBNAM=$P($G(^GMT(142.5,IEN,0)),U)
79 S VALUE=$$CRE^GMTSOBJ(HSOBNAM)
80 D CLEAN^VALM10
81 D INIT
82 Q
83 ;
84CHST ;
85 N DA,DIC,DIE,DIR,DIROUT,DR,DTOUT,DUOUT,HSIEN,POP,TEXT,X,Y,YESNO
86 D FULL^VALM1
87 I $P($G(^GMT(142.5,HSOBJ,0)),U,20)=1 W !,"Can't edit this National Object" H 2 Q
88 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
89 W !,"***WARNING*** By changing the HS Type this will change the output data."
90 S DIR(0)="YA0"
91 S DIR("A")="Continue? "
92 S DIR("B")="NO"
93 S DIR("?")="Enter Y or N. For detailed help type ??"
94 D ^DIR
95 I $D(DIROUT) S DTOUT=1
96 I $D(DTOUT)!($D(DUOUT)) Q
97 S YESNO=$E(Y(0))
98 I YESNO="Y" D
99 .S DIC=142,DIC(0)="AEMQ",DIC("S")="I Y'<1",DIC("A")="Enter HEALTH SUMMARY TYPE: "
100 .W ! D ^DIC
101 .I Y=-1 K DIC Q
102 .S HSIEN=+Y
103 .S DIE="^GMT(142.5,",DA=IEN,DR=".03///^S X=HSIEN" D ^DIE
104 .D CLEAN^VALM10
105 .D INIT
106 Q
107 ;
108CREATEHS ;
109 N POP
110 D FULL^VALM1
111 D TYPE^GMTSOBJ(HSTYNAM)
112 W ! S DIR(0)="E" D ^DIR
113 D CLEAN^VALM10
114 D INIT
115 Q
116 ;
117HELP ; -- help code
118 S X="?" D DISP^XQORM1 W !!
119 Q
120 ;
121XQORM ;
122 S XQORM("A")="Select Action: "
123 Q
124 ;
125EXIT ; -- exit code
126 Q
127 ;
128EXPND ; -- expand code
129 Q
130 ;
Note: See TracBrowser for help on using the repository browser.