source: FOIAVistA/trunk/r/HEALTH_DATA_AND_INFORMATICS-HDI/HDISVCUT.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 4.6 KB
Line 
1HDISVCUT ;CT/GRR ; 19 Apr 2006 10:57 AM
2 ;;1.0;HEALTH DATA & INFORMATICS;**6**;Feb 22, 2005
3BLDSTAT(HDISFILE,HDISFN,HDISSC,HDISSDT,HDISARRY) ;
4 N HDISOUT,CODE,HDISTDTX,Y
5 I HDISFILE=""!(HDISFN="")!(HDISARRY="") S HDISOUT=0_"^Parameter Missing" G QUIT
6 K @HDISARRY
7 S DIC=7115.3,DIC(0)="Z",X="DOMAIN STATUS UPDATE" D ^DIC K DIC
8 I Y<0 S HDISOUT=0_"^DOMAIN STATUS UPDATE Template Missing" G QUIT
9 S HDIST=+Y,HDISY=Y,HDISY(0)=Y(0)
10 S HDISSRC=$P($$SITE^VASITE(),"^",3)
11 S HDISPROD=$$PROD^XUPROD()
12 S HDISTDTX=$$FMTXML^HDISVU01(HDISSDT,"","")
13 S HDISMD=$G(^XMB("NETNAME"))
14 S @HDISARRY@(1)="<?xml version=""1.0"" encoding=""utf-8"" ?>"
15 ;S @HDISARRY@(1)=$$XMLHDR^XOBVLIB()
16 S @HDISARRY@(2)="<"_$P(HDISY(0),"^",4)_" "_$G(^HDIS(7115.3,HDIST,1))_">"
17 N Z K Z D ZINIT
18 S Z(20)=HDISSRC
19 S Z(22)=HDISPROD
20 S Z(30)=HDISMD
21 S Z(60)=HDISFILE
22 S Z(70)=HDISFN
23 S Z(80)=HDISSC
24 S Z(90)=HDISTDTX
25 D XMLOUT^HDISXML(HDIST,"20,22,30,60,70,80,90,10/","Z",HDISARRY,.HDERR)
26 S HDISOUT=1
27QUIT Q HDISOUT
28 ;
29ZINIT S Z(22)="" F Z=10:10:100 S Z(Z)=""
30 Q
31 ;
32 ;
33BLDSND(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY,HDISINP) ;
34 ;Updating of central server disabled (return success)
35 I $$GETSDIS^HDISVF03() Q 1
36 N HDISOUT
37 S:HDISSDT="" HDISSDT=DT
38 S:HDISARRY="" HDISARRY=$NA(^TMP("HDISSBUILD",$J))
39 S HDISOUT=$$BLDSTAT(HDISFILE,HDISFN,HDISSTCD,HDISSDT,HDISARRY)
40 I 'HDISOUT Q HDISOUT
41 S HDISOUT=$$SNDXML^HDISVM02(HDISARRY,2,HDISINP)
42 Q HDISOUT
43 ;
44STATUPD(FILE,FIELD,CODE,DATE) ;Encompassing local status update call
45 ; Input : FILE - File number
46 ; FIELD - Field number (defaults to .01)
47 ; CODE - Status code to set (defaults to "not started")
48 ; DATE - FileMan date/time to return status for (optional)
49 ; (defaults to NOW)
50 ;Output : 1 = Success 0^Text = Failure
51 ; Notes : This call will update the local status, build the Status
52 ; Update XML document, and forward the Status Update XML
53 ; document to the centralized server
54 ; : If time is not included with the date, 1 second past
55 ; midnight will be used as the time
56 ; : If an entry for the given file/field and date/time already
57 ; exists, the existing entry will be updated to reflect the
58 ; given status
59 N XMLARR,TMPARR,OUTPUT
60 ;Check input
61 S FILE=+$G(FILE)
62 I 'FILE Q "0^Parameter FILE was not passed"
63 S FIELD=+$G(FIELD)
64 I 'FIELD S FIELD=.01
65 S CODE=+$G(CODE)
66 S DATE=+$G(DATE)
67 I 'DATE S DATE=$$NOW^XLFDT()
68 I '$P(DATE,".",2) S $P(DATE,".",2)="000001"
69 ;Update local status
70 D SETSTAT^HDISVF01(FILE,FIELD,CODE,DATE,1)
71 ;Updating of central server disabled (return success)
72 I $$GETSDIS^HDISVF03() Q 1
73 ;Create status update xml doc and send to central server
74 S XMLARR=$NA(^TMP("HDISVCUT",$J,"XML"))
75 S TMPARR=$NA(^TMP("HDISVCUT",$J,"HDISINP"))
76 K @XMLARR,@TMPARR
77 S OUTPUT=$$BLDSND^HDISVCUT(FILE,FIELD,CODE,DATE,XMLARR,TMPARR)
78 K @XMLARR,@TMPARR
79 Q OUTPUT
80 ;
81VUID(HDDOM,HDROUT) ;Instantiate VUIDs for set of code fields
82 ; Input:
83 ; HDDOM - Domain Name (i.e. ORDERS)
84 ; HDROUT - Routine containing VUID Sets-Of-Code data (i.e. HDI1005B)
85 ;Output: 0 = Stop post-install (error)
86 ; 1 = Continue with post-install
87 N HDIMSG
88 S HDIMSG(1)=" "
89 S HDIMSG(2)="Seeding XTID VUID FOR SET OF CODES file (#8985.1) with "_HDDOM_" data"
90 S HDIMSG(3)=" "
91 D MES^XPDUTL(.HDIMSG) K HDIMSG
92 I '$$VUIDL^HDISVU02(HDDOM,HDROUT) Q 0
93 Q 1
94 ;
95UPDTDOM(HDDOM,HDISDFFS) ;Add Domain info to the HDIS DOMAIN file
96 ;
97 ; Input: HDDOM - Domain Name
98 ; HDISDFFS - Array containing File number set equal to Field Number (optional, .01 assumed)
99 ; (i.e. HDISDFFS(100.01)="")
100 ;Output: HDISERR - Set to 1 when error incurred
101 N HDIEN,HDIMSG
102 S HDIMSG(1)=" "
103 S HDIMSG(2)="Adding "_HDDOM_" Domain and related fields to"
104 S HDIMSG(3)="HDIS DOMAIN file (#7115.1)"
105 S HDIMSG(4)=" "
106 D MES^XPDUTL(.HDIMSG) K HDIMSG
107 I '$$FINDDOM^HDISVF09(HDDOM,.HDISDFFS,1,.HDISDIEN,.HDISERRM) D Q 0
108 .N HDIEN,HDIMSG
109 .S HDIMSG(1)=" "
110 .S HDIMSG(2)="Error occurred when updating HDIS DOMAIN file."
111 .S HDIMSG(3)=HDISERRM
112 .S HDIMSG(4)=" "
113 .D MES^XPDUTL(.HDIMSG) K HDIMSG
114 Q 1
115 ;
116 ;
117TESTACT() ;Set's the HDIS SYSTEM file fields to reflect a mirrored test account and remove any multiple entries
118 ;
119 ;Check file for multiple entries and delete if found
120 ;PATCH 6
121 ;
122 I $O(^HDISF(7118.21,1))>0 D ;multiple entries found
123 .N IEN,FDA,DA,DIK
124 .S IEN=1
125 .F S IEN=$O(^HDISF(7118.21,IEN)) Q:IEN'>0 D
126 ..S DA=IEN
127 ..S DIK="^HDISF(7118.21,"
128 ..D ^DIK
129 K FDA(1)
130 S FDA(1,7118.21,"?+1,",.01)=$P($G(^HDISF(7118.21,1,0)),"^",1)
131 S FDA(1,7118.21,"?+1,",.02)=$G(^XMB("NETNAME"))
132 S FDA(1,7118.21,"?+1,",.03)=$$PROD^XUPROD()
133 D UPDATE^DIE("","FDA(1)","RSLT","ERR(1)")
134 Q 1
135 ;
Note: See TracBrowser for help on using the repository browser.