source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGPOC.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 6.7 KB
Line 
1RGPOC ;BIR/PTD-ADD/EDIT POINT OF CONTACT OPTION ;8/22/01
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21,24**;30 Apr 99
3 ;
4 ;Reference to ^VA(200, supported by IA #2589
5 ;Reference to LINK^HLUTIL3 and $$GET1^DIQ(870 supported by IA #3335
6 ;Reference to DOMAIN (#4.2) file supported by IA #3452
7 ;
8INTRO ;Introduction to Option
9 W @IOF,!,"This option allows you to transmit information to the MPI/PD Data"
10 W !,"Management team so that the Point of Contact website can be updated."
11 W !!,"To obtain a list of MPI/PD Points of Contact for each facility,"
12 W !,"look for the POC web link on the MPI/PD Home Page."
13 W !!,"The COMMERCIAL PHONE (#.135) field in the NEW PERSON (#200) file"
14 W !,"will only accept numbers and punctuation, 4-20 characters."
15 W !!,"Please include the entire phone number:",!,"area code, 7 digit number and extension (e.g., AAA NNN NNNN XXXX)"
16 W !!,"A contact name without a phone number will NOT be transmitted."
17 W !," ==="
18 ;
19ASK ;Select POC to add/edit.
20 W ! K DIR S DIR(0)="LA^1:7"
21 S DIR("A")="Which Point of Contact information do you wish to update? "
22 S DIR("A",1)="Select one or more of the following:"
23 S DIR("A",2)="(A list or range of numbers can be entered, e.g., 1,3 or 2-4,6.)"
24 S DIR("A",3)=""
25 S DIR("A",4)=" 1 - Admin POC 2 - Alt Admin POC 3 - IRM POC 4 - Alt IRM POC"
26 S DIR("A",5)=" 5 - HL7 POC 6 - Alt HL7 POC 7 - ALL POCs"
27 S DIR("A",6)=""
28 S DIR("B")="7"
29 S DIR("?",1)="Enter:"
30 S DIR("?",2)=" ""1"" to add/edit Administrative Point of Contact."
31 S DIR("?",3)=" ""2"" to add/edit Alternate Administrative Point of Contact."
32 S DIR("?",4)=" ""3"" to add/edit IRM Point of Contact."
33 S DIR("?",5)=" ""4"" to add/edit Alternate IRM Point of Contact."
34 S DIR("?",6)=" ""5"" to add/edit Health Level Seven Point of Contact."
35 S DIR("?",7)=" ""6"" to add/edit Alternate Health Level Seven Point of Contact."
36 S DIR("?",8)=" ""7"" to add/edit ALL Points of Contact."
37 S DIR("?")=" You can enter a list or range of numbers, e.g., 1,3,5 or 1-3,6."
38 D ^DIR G:$D(DIRUT) END S RGANS=$S(Y[7:7,1:Y)
39 ;
40MAIN ;Direct flow based on variable RGANS.
41 S RGQUIT=0
42 I RGANS["1" D POC1^RGPOC1
43 I RGANS["2" D POC2^RGPOC1
44 I RGANS["3" D POC3^RGPOC1
45 I RGANS["4" D POC4^RGPOC1
46 I RGANS["5" D POC5^RGPOC1
47 I RGANS["6" D POC6^RGPOC1
48 I RGANS="7" S (RGADMOFN,RGAD2OFN,RGIRMOFN,RGIR2OFN,RGHL7OFN)="" D
49 .D POC1^RGPOC1 Q:RGADMONM=-1 Q:RGADMOFN=-1
50 .D POC2^RGPOC1 Q:RGAD2ONM=-1 Q:RGAD2OFN=-1
51 .D POC3^RGPOC1 Q:RGIRMONM=-1 Q:RGIRMOFN=-1
52 .D POC4^RGPOC1 Q:RGIR2ONM=-1 Q:RGIR2OFN=-1
53 .D POC5^RGPOC1 Q:RGHL7ONM=-1 Q:RGHL7OFN=-1
54 .D POC6^RGPOC1
55 D SEND
56AGAIN ;Return to selection prompt?
57 I RGQUIT=1 D END Q
58 W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to add/edit another contact"
59 D ^DIR I +Y=1 D END W @IOF G ASK
60 D END
61 Q
62 ;
63SEND ;Send message to Data Management Team
64 Q:'$O(RGARRAY(0))
65 ;Display changed fields.
66 W @IOF,!,"The following data will be transmitted to the MPI/PD Data Management team.",!
67 S RGNUM=0
68 F S RGNUM=$O(RGARRAY(RGNUM)) Q:'RGNUM W !,RGARRAY(RGNUM)
69 ;
70DOMAIN ;Determine test or production account (production must have
71 ;"MPI-AUSTIN.VA.GOV" domain for logical link "MPIVA").
72 ;Get logical link IEN for "MPIVA".
73 ;Get domain for "MPIVA" logical link in HL LOGICAL LINK (#870) file.
74 N RGDOMAIN,RGDMNC S RGDOMAIN=""
75 D LINK^HLUTIL3("200M",.HLL,"I")
76 S IEN=$O(HLL(0)) I +IEN>0 S RGDOMAIN=$$GET1^DIQ(870,+IEN_",",.03)
77 S RGDMNC=$$FIND1^DIC(4.2,"","MQ","MPI-AUSTIN.VA.GOV") I RGDMNC>0 S RGDMNC=$$GET1^DIQ(4.2,RGDMNC_",",.01)
78 I RGDOMAIN="" Q
79 I RGDOMAIN'=RGDMNC W !!,"No data will be transmitted from a TEST account." Q ;Not production; quit SEND.
80 ;
81 ;Transmit e-mail message.
82 S XMSUB="POINT OF CONTACT CHANGE - SITE "_$P($$SITE^VASITE(),"^",3)
83 S XMDUZ=DUZ ;name of person editing the option
84 S XMY("G.MPI/PD POC UPDATE@MPI-AUSTIN.MED.VA.GOV")=""
85 S XMTEXT="RGARRAY("
86 ;
87 S RGARRAY(1)="There has been a change in the point of contact information from"
88 S RGARRAY(2)=$P($$SITE^VASITE(),"^",2)_" (station number "_$P($$SITE^VASITE(),"^",3)_")."
89 S RGARRAY(3)=""
90 D ^XMD
91 W !!,"Sending information to the MPI/PD Data Management team now.",!
92 Q
93 ;
94END ;Kill variables
95 K DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,HLL,IEN,RGAD2NFN,RGAD2NNM,RGAD2OFN,RGAD2ONM,RGADMNFN
96 K RGADMNNM,RGADMOFN,RGADMONM,RGANS,RGARRAY,RGDATA,RGDOMAIN,RGHL2NFN,RGHL2NNM,RGHL2OFN
97 K RGHL2ONM,RGHL7NFN,RGHL7NNM,RGHL7OFN,RGHL7ONM,RGIR2NFN,RGIR2NNM,RGIR2OFN,RGIR2ONM
98 K RGIRMNFN,RGIRMNNM,RGIRMOFN,RGIRMONM,RGNUM,RGQUIT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
99 Q
100 ;
101NAME(RGPC,RGFLD) ;Edit IEN of POC from CIRN SITE PARAMETER (#991.8) file.
102 ;RGPC - piece number of POC on the ^RGSITE(991.8,1,"POC" node
103 ;RGFLD - field number of POC to be used in the DR string
104 ;Returns POC IEN before edit^POC IEN after edit OR -1^error message
105 ;
106 N RGOLDNAM,RGNEWNAM
107 S RGOLDNAM=$P($G(^RGSITE(991.8,1,"POC")),"^",RGPC)
108 L +^RGSITE(991.8):10
109 S DIE="^RGSITE(991.8,",DA=1,DR=RGFLD
110 D ^DIE K DA,DIE,DR
111 L -^RGSITE(991.8)
112 I $D(DTOUT)&(RGOLDNAM="") Q "-1^USER TIMED OUT"
113 I $D(Y) Q "-1^USER UP-ARROWED OUT"
114 S RGNEWNAM=$P($G(^RGSITE(991.8,1,"POC")),"^",RGPC)
115 Q RGOLDNAM_"^"_RGNEWNAM
116 ;
117PHONE(RGIEN) ;Edit POC COMMERCIAL PHONE (#.135) from NEW PERSON (#200) file.
118 ;Supported IA #10060 allows read/FileMan for all fields in ^VA(200
119 ;RGIEN - IEN for NEW PERSON for whom phone number is needed
120 ;Returns POC COMMERCIAL PHONE before edit^POC COMMERCIAL PHONE after edit
121 ;
122 N RGOLDFON,RGNEWFON
123 S RGOLDFON=$$GET1^DIQ(200,RGIEN,.135)
124 S RGOLDFON=$TR(RGOLDFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
125 S RGOLDFON=$TR(RGOLDFON,"()","")
126 ;Edit COMMERCIAL PHONE (#.135), NEW PERSON (#200) file
127 ;IA #2589 allows write/FileMan to field .135 in ^VA(200,
128 L +^VA(200,RGIEN):10
129 S DIE="^VA(200,",DA=RGIEN,DR=.135
130 D ^DIE K DA,DIE,DR
131 L -^VA(200,RGIEN)
132 I $D(DTOUT)&(RGOLDFON="") Q "-1^USER TIMED OUT"
133 I $D(Y) Q "-1^USER UP-ARROWED OUT"
134 S RGNEWFON=$$GET1^DIQ(200,RGIEN,.135)
135 S RGNEWFON=$TR(RGNEWFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
136 S RGNEWFON=$TR(RGNEWFON,"()","")
137 Q RGOLDFON_"^"_RGNEWFON
138 ;
139CNVRTNM(NAME) ;Convert IEN from NEW PERSON (#200) to printable name
140 ;NAME - ien for POC
141 N RGNAME
142 I NAME="" Q "<NULL>"
143 S RGNAME=$$GET1^DIQ(200,NAME,.01)
144 Q RGNAME
145 ;
146ERROR1(RGPOC) ;Write error message 1 for type POC.
147 W !!,"No "_RGPOC_" Point of Contact identified."
148 Q
149 ;
150ERROR2(RGPOC,RGFLD,RGOLDNAM,RGNEWNAM) ;Write error message 2 for type POC.
151 W !!,"No "_RGPOC_" Point of Contact phone number identified."
152 ;User timed out or up-arrowed out on phone number.
153 ;Restore name value to original value, if value changed.
154 I RGOLDNAM=RGNEWNAM K RGFLD,RGOLDNAM,RGNEWNAM,RGPOC Q
155 L +^RGSITE(991.8):10
156 S DIE="^RGSITE(991.8,",DA=1,DR=RGFLD_"///^S X=$S(RGOLDNAM="""":""@"",1:RGOLDNAM)"
157 D ^DIE
158 L -^RGSITE(991.8)
159 K DA,DIE,DR,RGFLD,RGOLDNAM
160 W !,RGPOC_" Point of Contact restored to original value."
161 Q
162 ;
Note: See TracBrowser for help on using the repository browser.