source: FOIAVistA/tag/r/HEALTH_SUMMARY-GMTS/GMTSOBI.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1GMTSOBI ; SLC/KER - HS Object - Import/Install ; 01/06/2003
2 ;;2.7;Health Summary;**58**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 10096 ^%ZOSF("DEL"
6 ; DBIA 10013 IX1^DIK
7 ; DBIA 10112 $$SITE^VASITE
8 ; DBIA 2055 $$FLDNUM^DILFD (file 142.5)
9 ; DBIA 10103 $$NOW^XLFDT
10 ; DBIA 10013 ^DIK
11 ;
12EN ; Install Object from Routine GMTSOBX
13 N DA,DIK,GMTS3,GMTS4,GMTSC,GMTSEDAT,GMTSETYP,GMTSETTL,GMTSDAO
14 N GMTSDAT,GMTSDR,GMTSEX,GMTSFAC,GMTSFRM,GMTSI,GMTSIEN,GMTSIT
15 N GMTSL,GMTSLN,GMTSNDD,GMTSOBJ,GMTSOBX,GMTSON,GMTSQIT,GMTSR
16 N GMTSROK,GMTSRT,GMTSRTN,GMTST,GMTSTE,GMTSTN,GMTSTMP,GMTSTR
17 N GMTSTTL,GMTSTXT,GMTSTYP,GMTSUSR,X
18 I +($$FLDNUM^DILFD(142.5,"NAME"))'>0!('$D(^GMT(142.5))) D Q
19 . W !," Unable to find HEALTH SUMMARY OBJECTS file #142.5"
20 S GMTSEDAT=0,GMTSRTN="GMTSOBX",GMTSQIT=0,GMTSUSR=+($G(DUZ)) I +GMTSUSR=0 W !!," User not defined" Q
21 I +($$ROK^GMTSOBU(GMTSRTN))'>0 W !," Error:",!," Object not Found (routine GMTSOBX)" Q
22 F GMTSI=1:1:7 D
23 . S GMTST=$$TX^GMTSOBU(GMTSRTN,GMTSRTN,(GMTSI-1)) S:GMTST["Object: " GMTSOBJ=$P(GMTST,"Object: ",2)
24 . S:GMTST["From: " GMTSFRM=$P(GMTST,"From: ",2) S:GMTST["Sender: " GMTSDR=$P(GMTST,"Sender: ",2)
25 S (GMTSON,GMTSOBJ)=$P($$TX^GMTSOBU(GMTSRTN,"OBJ",1),";",2)
26 S (GMTSTN,GMTSTYP)=$P($$TX^GMTSOBU(GMTSRTN,"TYPE",1),";",2)
27 I GMTSOBJ=""!(GMTSFRM="")!(GMTSDR="") W !," Error:",!," Can not install object from ",GMTSRTN Q
28 W !," Installing Health Summary Object: ",GMTSOBJ
29 I $L(GMTSTYP) D
30 . W !," Using Health Summary Type: ",GMTSTYP
31 W !," From: ",GMTSFRM
32 W !," Sender: ",GMTSDR
33 S GMTSTTL=$P($$TX^GMTSOBU(GMTSRTN,"TYPE",2),";",2)
34 ; Check Facility
35 S GMTSFAC=+($P($$SITE^VASITE,"^",3)) I +GMTSFAC=0 W !," Error:",!," Facility not defined" Q
36 ; Check Object
37 W !!," Checking Health Summary Object file #142.5"
38 I $L(GMTSOBJ) D Q:GMTSQIT
39 . N GMTSTMP S GMTSTMP=$$BOX^GMTSOBU(GMTSOBJ) I +($G(GMTSTMP))>0 W ! D ER1^GMTSOBU S GMTSQIT=1
40 ; Check Type
41 W !," Check Health Summary Type file #142"
42 I $L(GMTSTYP) D Q:GMTSQIT
43 . S GMTSQIT=1 N GMTSTMP S GMTSTMP=$$NWX^GMTSOBU(GMTSTYP)
44 . S:+($G(GMTSTMP))'>0 GMTSQIT=0 I +($G(GMTSTMP))>0 D
45 . . S GMTSEDAT=$$EHST^GMTSOBU I GMTSEDAT>0 D Q
46 . . . S GMTSDAT=GMTSEDAT,GMTSQIT=0 I $L($G(GMTSETYP)),$L($G(GMTSETTL)) D
47 . . . . S GMTSTYP=GMTSETYP,GMTSTTL=GMTSETTL
48 ; Check Title
49 W !," Checking for Duplicate Title"
50 I $L(GMTSTTL) D Q:GMTSQIT
51 . N GMTSTMP S GMTSTMP=$$TWX^GMTSOBU(GMTSTTL) I +GMTSTMP>0 W ! D ER3^GMTSOBU S GMTSQIT=1
52 S GMTSDAT=$$TIEN^GMTSOBU S:+($G(GMTSEDAT))>0 GMTSDAT=+($G(GMTSEDAT))
53 S:GMTSDAT'>0 GMTSQIT=1
54 I GMTSQIT W !," Unable to add Health Summary Type" Q
55 S GMTSDAO=$$OIEN^GMTSOBU(GMTSFAC) S:GMTSDAO'>0 GMTSQIT=1
56 I GMTSQIT W !," Unable to add Health Summary Object" Q
57 L +^GMT(142,+GMTSDAT):0 S:'$T GMTSQIT=1
58 L +^GMT(142.5,+GMTSDAO):0 S:'$T GMTSQIT=1
59 I +($G(GMTSQIT))>0 L -^GMT(142,+GMTSDAT) L -^GMT(142,+GMTSDAO) D Q
60 . W !," Unable to add Health Summary Type and Object"
61 I GMTSDAT>0,GMTSDAO>0,GMTSQIT'>0 D HST,HSO
62 D DELERR L -^GMT(142,+GMTSDAT) L -^GMT(142,+GMTSDAO)
63 D DONE W !
64 Q
65HST ; Install Health Summary Type
66 ; Needs GMTSRTN, GMTSDAT, GMTSUSR, GMTSTYP, GMTSTTL
67 Q:+($G(GMTSTE))>0 N GMTSROK,GMTSI,GMTSTXT,GMTSTR,GMTSNDD,GMTSR,GMTSC,GMTSRT,GMTS3,GMTS4,DA,DIK
68 Q:+($G(GMTSQIT))>0 S GMTSQIT=0,GMTSROK=$$ROK^GMTSOBU(GMTSRTN) Q:GMTSROK'>0
69 ; Save Type
70 I '$L(GMTSTYP)!('$L(GMTSTTL)) S GMTSQIT=1 Q
71 F GMTSI=3:1 Q:GMTSQIT D Q:GMTSQIT
72 . S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"TYPE",GMTSI),GMTSTXT=$P(GMTSTXT," ;",2,299)
73 . I '$L(GMTSTXT) S GMTSQIT=1 Q
74 . S GMTSTR=$P(GMTSTXT,";",1),GMTSNDD=$P(GMTSTXT,";",2)
75 . S GMTSR=$P(GMTSTR,",",2),GMTSC=$P(GMTSNDD,"^",2)
76 . Q:GMTSR>0&(GMTSC>0)&('$D(^GMT(142.1,+GMTSC))) Q:(GMTSR>0)&(GMTSC>0)&(GMTSC>999)
77 . S:GMTSTR="0" $P(GMTSNDD,"^",3)=GMTSUSR
78 . S:GMTSTR="0"&($L(GMTSTYP)) $P(GMTSNDD,"^",1)=GMTSTYP
79 . S:GMTSTR="""T"""&($L(GMTSTTL)) $P(GMTSNDD,"^",1)=GMTSTTL
80 . S GMTSNDD=$TR(GMTSNDD,"""","") S:'$L(GMTSNDD) GMTSNDD=""""""
81 . S GMTSRT="^GMT(142,DA,"_GMTSTR_")"
82 . S DA=GMTSDAT S @GMTSRT=GMTSNDD
83 ; Check Indexes
84 S GMTSQIT=0 F GMTSI="B","C" S GMTSR=0 F S GMTSR=$O(^GMT(142,GMTSDAT,1,GMTSI,GMTSR)) Q:+GMTSR=0 D
85 . S GMTSC=0 F S GMTSC=$O(^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC)) Q:+GMTSC=0 D
86 . . I '$D(^GMT(142,GMTSDAT,1,GMTSC)) K ^GMT(142,GMTSDAT,1,GMTSI,GMTSR,GMTSC)
87 ; Re-Index
88 S DA=GMTSDAT,DIK="^GMT(142," D IX1^DIK
89 ; Check Structure (sub-file 142.01)
90 S (GMTSI,GMTS3,GMTS4)=0 F S GMTSI=$O(^GMT(142,GMTSDAT,1,GMTSI)) Q:+GMTSI=0 D
91 . S GMTS3=GMTSI,GMTS4=GMTS4+1
92 S:GMTS3>0&(GMTS4>0)&($D(^GMT(142,GMTSDAT,1,0))) ^GMT(142,+GMTSDAT,1,0)="^142.01IA^"_GMTS3_"^"_GMTS4
93 Q
94HSO ; Install Health Summary Object
95 ; Needs GMTSRTN, GMTSDAO,GMTSUSR
96 Q:+($G(GMTSQIT))>0 N GMTSQIT,GMTSROK,GMTSTXT,GMTSOBJ,GMTSNDD,GMTSTR,GMTSRT,DA,DIK
97 S GMTSQIT=0,GMTSROK=$$ROK^GMTSOBU(GMTSRTN) Q:GMTSROK'>0
98 S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",1),GMTSOBJ=$P(GMTSTXT,";",2,299)
99 S GMTSTXT=$$TX^GMTSOBU(GMTSRTN,"OBJ",2),$P(GMTSTXT,"^",17)=GMTSUSR,GMTSNDD=GMTSTXT
100 S GMTSTR=$P(GMTSNDD,";",2),GMTSNDD=$P(GMTSNDD,";",3,299)
101 S GMTSRT="^GMT(142.5,DA,"_GMTSTR_")",DA=GMTSDAO,DIK="^GMT(142.5,"
102 S $P(GMTSNDD,"^",3)=+($G(GMTSDAT)),$P(GMTSNDD,"^",17)=+($G(GMTSUSR))
103 S $P(GMTSNDD,"^",18)=$$NOW^XLFDT H 1 S $P(GMTSNDD,"^",19)=$$NOW^XLFDT
104 S $P(GMTSNDD,"^",20)=0,@GMTSRT=GMTSNDD D IX1^DIK
105 Q
106DELERR ; Delete on Error
107 I +($G(GMTSDAT))>0,+($G(GMTSDAO))'>0 D
108 . D DI(+($G(GMTSDAT)),"^GMT(142,")
109 . W !," An error has occurred while installing Health Summary Object"
110 . W !," Deleting the associated Health Summary Type"
111 I +($G(GMTSDAT))'>0,+($G(GMTSDAO))>0 D
112 . D DI(+($G(GMTSDAO)),"^GMT(142.5,")
113 . W !," An error has occurred while installing Health Summary Type"
114 . W !," Deleting the associated Health Summary Object"
115 I +($G(GMTSDAT))>0&('$D(^GMT(142,+GMTSDAT))) D
116 . D DI(+($G(GMTSDAT)),"^GMT(142,"),DEL(+($G(GMTSDAO)),"^GMT(142.5,")
117 . W !," An error has occurred while installing Health Summary Type"
118 . W !," Deleting the associated Health Summary Object"
119 I +($G(GMTSDAO))>0&('$D(^GMT(142.5,+GMTSDAO))) D
120 . D DI(+($G(GMTSDAT)),"^GMT(142,"),DEL(+($G(GMTSDAO)),"^GMT(142.5,")
121 . W !," An error has occurred while installing Health Summary Object"
122 . W !," Deleting the associated Health Summary Type"
123 Q
124DI(X,Y) ; Delete Item
125 N DA,DIK S DA=+($G(X)),DIK=$G(Y) D:$L(DIK) ^DIK
126 Q
127DONE ; Completed
128 I +($G(GMTSDAT))>0,+($G(GMTSDAO))>0 D
129 . I $D(^GMT(142,+GMTSDAT,0)),$D(^GMT(142.5,+GMTSDAO,0)) D
130 . . H 1 I $L(GMTSTN),$L(GMTSON) D Q
131 . . . W !!," Object '",GMTSON,"' installed using Health Summary Type '",GMTSTN,"'"
132 . . W !," Object Installed"
133 Q
134DEL(X) ; Delete Routine X
135 S X=$G(X) Q:'$L(X) Q:$L(X)>8 Q:$$ROK^GMTSOBU(X)=0 X ^%ZOSF("DEL") Q
Note: See TracBrowser for help on using the repository browser.