source: WorldVistAEHR/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGRSUTL2.m@ 1006

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

initial load of WorldVistAEHR

File size: 4.1 KB
Line 
1RGRSUTL2 ;ALB/RJS-UTILITIES FOR CIRN ;1/2/97
2 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
3 ;
4SSN(SSN,ARRAY) ;RETURNS DFN'S OF ALL SSN'S OR PSUEDO'S THAT MATCH
5 ; THE SSN PASSED
6 ; CALLING ROUTINE MUST KILL ARRAY BEFORE CALLING THIS
7 ; FUNCTION
8 Q:$G(SSN)=""!($G(ARRAY)="")
9 N RGDFN S RGDFN=0
10 F S RGDFN=$O(^DPT("SSN",SSN,RGDFN)) Q:RGDFN'>0 D SET(RGDFN)
11 I $D(@ARRAY) Q 1
12 Q 0
13SET(DFN) ;
14 Q:'$D(^DPT(DFN,0))
15 S @ARRAY@(DFN)=$P(^DPT(DFN,0),"^",1)
16 Q
17 ; This function determines if a word is singular or plural and also
18 ; determines if "no" or a numeric value is placed in front of
19 ; the word (ie no exception(s)).
20SNGPLR(RGNUM,RGSNG,RGPLR) ;
21 N RGZ
22 S RGZ=RGSNG?.E1L.E,RGPLR=$G(RGPLR,RGSNG_$S(RGZ:"s",1:"S"))
23 Q $S('RGNUM:$S(RGZ:"no ",1:"NO ")_RGPLR,RGNUM=1:"1 "_RGSNG,1:RGNUM_" "_RGPLR)
24 ; Display formatted title
25TITLE(RGTTL,RGVER,RGFN) ;
26 I '$D(IOM) N IOM,IOF S IOM=80,IOF="#"
27 S RGVER=$G(RGVER,"1.0")
28 S:RGVER RGVER="Version "_RGVER
29 U $G(IO,$I)
30 W @IOF,$S(IO=IO(0):$C(27,91,55,109),1:""),$C(13)
31 S Y=$$DT^XLFDT X ^DD("DD")
32 W Y,?(IOM-$L(RGTTL)\2),RGTTL,?(IOM-$L(RGVER)),RGVER,!,$S(IO=IO(0):$C(27,91,109),1:$$UND),!
33 W:$D(RGFN) ?(IOM-$L(RGFN)\2),RGFN,!
34 Q
35 ; Pause for user response
36PAUSE(RGP,RGX,RGY) ;
37 Q $$GETCH($G(RGP,"Press RETURN or ENTER to continue..."),U,.RGX,.RGY)
38 ; Single character read
39GETCH(RGP,RGV,RGX,RGY,RGT,RGD) ;
40 N RGZ,RGC
41 W:$D(RGX)!$D(RGY) $$XY($G(RGX,$X),$G(RGY,$Y))
42 W $G(RGP)
43 S RGT=$G(RGT,$G(DTIME,999999999999)),RGD=$G(RGD,U),RGC=""
44 S:$D(RGV) RGV=$$UP^XLFSTR(RGV)_U
45 F D Q:'$L(RGZ)
46 .S RGZ=$$READ^XGF(1,RGT)
47 .E S RGC=RGD Q
48 .W $C(8)
49 .Q:'$L(RGZ)
50 .S RGZ=$$UP^XLFSTR(RGZ)
51 .I $D(RGV) D
52 ..I RGV[RGZ S RGC=RGZ
53 ..E W $C(7,32,8) S RGC=""
54 .E S RGC=RGZ
55 W !
56 Q RGC
57 ; Convert X to base Y padded to length L
58BASE(X,Y,L) ;
59 Q:(Y<2)!(Y>62) ""
60 N RGZ,RGZ1
61 S RGZ1="",X=$S(X<0:-X,1:X)
62 F S RGZ=X#Y,X=X\Y,RGZ1=$C($S(RGZ<10:RGZ+48,RGZ<36:RGZ+55,1:RGZ+61))_RGZ1 Q:'X
63 Q $S('$G(L):RGZ1,1:$$REPEAT^XLFSTR(0,L-$L(RGZ1))_$E(RGZ1,1,L))
64 ;
65 ; Output an underline X bytes long
66UND(X) Q $$REPEAT^XLFSTR("-",$G(X,$G(IOM,80)))
67 ;
68 ; Position cursor
69XY(DX,DY) ;
70 D:$G(IOXY)="" HOME^%ZIS
71 S DX=$S(+$G(DX)>0:+DX,1:0),DY=$S(+$G(DY)>0:+DY,1:0),$X=0
72 X IOXY
73 S $X=DX,$Y=DY
74 ; Send an alert.
75 ; XQAMSG = Message to send
76 ; RGUSR = A semicolon-delimited list of users to receive alert.
77ALERT(XQAMSG,RGUSR) ;
78 N XQA,XQAOPT,XQAFLG,XQAROU,XQADATA,XQAID
79 S @$$TRAP^RGZOSF("EXIT^RGRSUTL2"),RGUSR=$G(RGUSR,"*"),XQAMSG=$TR(XQAMSG,U,"~")
80 D ENTRY(RGUSR,.XQA),SETUP^XQALERT:$D(XQA)
81EXIT Q
82 ; Takes a list of receipients as input and produces an array of
83 ; DUZ's as output.
84 ; Inputs:
85 ; RGUSR = Semicolon-delimited list of recipients
86 ; RGLST = Special token list
87 ; Outputs:
88 ; RGOUT = Local array to receive DUZ list
89ENTRY(RGUSR,RGOUT,RGLST) ;
90 N RGZ,RGZ1,RGZ2
91 K RGOUT
92 F RGZ=1:1:$L(RGUSR,";") S RGZ1=$P(RGUSR,";",RGZ) D:RGZ1'="" S:RGZ1 RGOUT(+RGZ1)=""
93 .S:$D(RGLST(RGZ1)) RGZ1=RGLST(RGZ1)
94 .Q:RGZ1?.N
95 .I RGZ1?1"-"1.N D MGRP(-RGZ1) S RGZ1=0 Q
96 .S RGZ2=$E(RGZ1,1,2)
97 .I RGZ2="G." D MGRP($E(RGZ1,3,999)) Q
98 .I RGZ2="L." D LIST($E(RGZ1,3,999)) Q
99 .S RGZ1=$$LKP(RGZ1)
100 Q
101LKP(RGNAME) ;
102 N RGZ,RGZ1
103 I $D(^VA(200,"B",RGNAME)) S RGZ=RGNAME G L1
104 S RGZ=$O(^(RGNAME)),RGZ1=$O(^(RGZ))
105 Q:(RGZ="")!(RGNAME'=$E(RGZ,1,$L(RGNAME))) 0
106 Q:(RGZ1'="")&(RGNAME=$E(RGZ1,1,$L(RGNAME))) 0
107L1 S RGZ1=$O(^(RGZ,0)),RGZ=$O(^(RGZ1))
108 Q:'RGZ1!RGZ 0
109 Q RGZ1
110 ; Send a mail message.
111MAIL(RGMSG,XMY,XMSUB,XMDUZ) ;
112 N XMTEXT
113 S:$D(RGMSG)=1 RGMSG(1)=RGMSG
114 S XMTEXT="RGMSG(",@$$TRAP^RGZOSF("EXIT^RGRSUTL2"),XMY=$G(XMY)
115 S:$G(XMSUB)="" XMSUB=RGMSG
116 S:$G(XMDUZ)="" XMDUZ=$G(DUZ)
117 F Q:'$L(XMY) S X=$P(XMY,";"),XMY=$P(XMY,";",2,999) S:$L(X) XMY(X)=""
118 D ^XMD:$D(XMY)>9
119 Q
120LIST(RGLIST) ;
121 Q:RGLIST=""
122 S:RGLIST'=+RGLIST RGLIST=+$O(^RGCDSS(993.6,"B",RGLIST,0))
123 S @$$TRAP^RGZOSF("LERR^RGUTUSR")
124 X:$D(^RGCDSS(993.6,RGLIST,1)) ^(1)
125LERR Q
126MGRP(RGMGRP) ;
127 N RGX
128 S RGX(0)=""
129 D MGRP2(RGMGRP)
130 Q
131MGRP2(RGMGRP) ;
132 N RGZ,RGZ1
133 Q:RGMGRP=""
134 S:RGMGRP'=+RGMGRP RGMGRP=+$O(^XMB(3.8,"B",RGMGRP,0))
135 Q:$D(RGX(RGMGRP))
136 S RGX(RGMGRP)=""
137 F RGZ=0:0 S RGZ=+$O(^XMB(3.8,RGMGRP,1,RGZ)) Q:'RGZ S RGOUT(+^(RGZ,0))=""
138 F RGZ=0:0 S RGZ=+$O(^XMB(3.8,RGMGRP,5,RGZ)) Q:'RGZ D MGRP2(^(RGZ,0))
139 Q
Note: See TracBrowser for help on using the repository browser.