source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRRUTL.m@ 1394

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

initial load of FOIAVistA 6/30/08 version

File size: 1.8 KB
Line 
1DGRRUTL ;alb/aas - DG Replacement and Rehosting RPC for VADPT ;10/21/05 13:19
2 ;;5.3;Registration;**538**;Aug 13, 1993
3 ;
4 QUIT
5 ;
6ADD(STR) ; -- add string to array
7 SET DGRRLINE=DGRRLINE+1
8 SET @DGRRESLT@(DGRRLINE)=STR
9 QUIT
10 ;
11CHARCHK(STR) ; -- replace xml character limits with entities
12 NEW A,I,X,Y,Z,NEWSTR
13 SET (Y,Z)=""
14 IF STR["&" SET NEWSTR=STR DO SET STR=Y_Z
15 . FOR X=1:1 SET Y=Y_$PIECE(NEWSTR,"&",X)_"&",Z=$PIECE(STR,"&",X+1,999) QUIT:Z'["&"
16 IF STR["<" FOR SET STR=$PIECE(STR,"<",1)_"&lt;"_$PIECE(STR,"<",2,99) Q:STR'["<"
17 IF STR[">" FOR SET STR=$PIECE(STR,">",1)_"&gt;"_$PIECE(STR,">",2,99) Q:STR'[">"
18 IF STR["'" FOR SET STR=$PIECE(STR,"'",1)_"&apos;"_$PIECE(STR,"'",2,99) Q:STR'["'"
19 IF STR["""" FOR SET STR=$PIECE(STR,"""",1)_"&quot;"_$PIECE(STR,"""",2,99) QUIT:STR'[""""
20 ;
21 FOR I=1:1:$LENGTH(STR) DO
22 . SET X=$EXTRACT(STR,I)
23 . SET A=$ASCII(X)
24 . IF A<31 S STR=$P(STR,X,1)_$P(STR,X,2,99)
25 QUIT STR
26 ;
27SITENO() ; institution number, including suffix, from vasite.
28 Q $P($$SITE^VASITE(),"^",3)
29 ;
30SITENAM() ; - Institution name, from vasite
31 Q $P($$SITE^VASITE(),"^",2)
32 ;
33PRODST1() ; Production account status check 1
34 ; -- Returns 1 if production, 0 if not
35 N X S X=$G(^XMB("NETNAME"))
36 Q $L(X,".")=3!($L(X,".")=4&(X[".MED."))
37 ;
38PRODST2() ; Production account status check 2
39 ; -- returns 1 if Default Processing Id from HL COMMUNICATION SERVER PARAMETERS file is Production, 0 if not
40 Q ($P($$PARAM^HLCS2,"^",3)="P")
41 ;
42DOMAIN() ; -- get the default domain
43 QUIT $$KSP^XUPARAM("WHERE")
44 ;
45XMLHDR() ; -- provides current XML standard header
46 QUIT "<?xml version=""1.0"" encoding=""utf-8"" ?>"
47 ;
48CHKSUM(ARRAY) ;
49 NEW VAL,ITEM,DATA,CHAR
50 SET VAL=0
51 SET ITEM=0
52 FOR S ITEM=$ORDER(ARRAY(ITEM)) QUIT:ITEM="" SET DATA=ARRAY(ITEM) DO
53 . FOR CHAR=1:1:$L(DATA) S VAL=($ASCII(DATA,CHAR)*CHAR*ITEM)+VAL
54 QUIT VAL
Note: See TracBrowser for help on using the repository browser.