RGPOC ;BIR/PTD-ADD/EDIT POINT OF CONTACT OPTION ;8/22/01
;;1.0;CLINICAL INFO RESOURCE NETWORK;**21,24**;30 Apr 99
;
;Reference to ^VA(200, supported by IA #2589
;Reference to LINK^HLUTIL3 and $$GET1^DIQ(870 supported by IA #3335
;Reference to DOMAIN (#4.2) file supported by IA #3452
;
INTRO ;Introduction to Option
W @IOF,!,"This option allows you to transmit information to the MPI/PD Data"
W !,"Management team so that the Point of Contact website can be updated."
W !!,"To obtain a list of MPI/PD Points of Contact for each facility,"
W !,"look for the POC web link on the MPI/PD Home Page."
W !!,"The COMMERCIAL PHONE (#.135) field in the NEW PERSON (#200) file"
W !,"will only accept numbers and punctuation, 4-20 characters."
W !!,"Please include the entire phone number:",!,"area code, 7 digit number and extension (e.g., AAA NNN NNNN XXXX)"
W !!,"A contact name without a phone number will NOT be transmitted."
W !," ==="
;
ASK ;Select POC to add/edit.
W ! K DIR S DIR(0)="LA^1:7"
S DIR("A")="Which Point of Contact information do you wish to update? "
S DIR("A",1)="Select one or more of the following:"
S DIR("A",2)="(A list or range of numbers can be entered, e.g., 1,3 or 2-4,6.)"
S DIR("A",3)=""
S DIR("A",4)=" 1 - Admin POC 2 - Alt Admin POC 3 - IRM POC 4 - Alt IRM POC"
S DIR("A",5)=" 5 - HL7 POC 6 - Alt HL7 POC 7 - ALL POCs"
S DIR("A",6)=""
S DIR("B")="7"
S DIR("?",1)="Enter:"
S DIR("?",2)=" ""1"" to add/edit Administrative Point of Contact."
S DIR("?",3)=" ""2"" to add/edit Alternate Administrative Point of Contact."
S DIR("?",4)=" ""3"" to add/edit IRM Point of Contact."
S DIR("?",5)=" ""4"" to add/edit Alternate IRM Point of Contact."
S DIR("?",6)=" ""5"" to add/edit Health Level Seven Point of Contact."
S DIR("?",7)=" ""6"" to add/edit Alternate Health Level Seven Point of Contact."
S DIR("?",8)=" ""7"" to add/edit ALL Points of Contact."
S DIR("?")=" You can enter a list or range of numbers, e.g., 1,3,5 or 1-3,6."
D ^DIR G:$D(DIRUT) END S RGANS=$S(Y[7:7,1:Y)
;
MAIN ;Direct flow based on variable RGANS.
S RGQUIT=0
I RGANS["1" D POC1^RGPOC1
I RGANS["2" D POC2^RGPOC1
I RGANS["3" D POC3^RGPOC1
I RGANS["4" D POC4^RGPOC1
I RGANS["5" D POC5^RGPOC1
I RGANS["6" D POC6^RGPOC1
I RGANS="7" S (RGADMOFN,RGAD2OFN,RGIRMOFN,RGIR2OFN,RGHL7OFN)="" D
.D POC1^RGPOC1 Q:RGADMONM=-1 Q:RGADMOFN=-1
.D POC2^RGPOC1 Q:RGAD2ONM=-1 Q:RGAD2OFN=-1
.D POC3^RGPOC1 Q:RGIRMONM=-1 Q:RGIRMOFN=-1
.D POC4^RGPOC1 Q:RGIR2ONM=-1 Q:RGIR2OFN=-1
.D POC5^RGPOC1 Q:RGHL7ONM=-1 Q:RGHL7OFN=-1
.D POC6^RGPOC1
D SEND
AGAIN ;Return to selection prompt?
I RGQUIT=1 D END Q
W ! K DIR S DIR(0)="Y",DIR("B")="NO",DIR("A")="Do you want to add/edit another contact"
D ^DIR I +Y=1 D END W @IOF G ASK
D END
Q
;
SEND ;Send message to Data Management Team
Q:'$O(RGARRAY(0))
;Display changed fields.
W @IOF,!,"The following data will be transmitted to the MPI/PD Data Management team.",!
S RGNUM=0
F S RGNUM=$O(RGARRAY(RGNUM)) Q:'RGNUM W !,RGARRAY(RGNUM)
;
DOMAIN ;Determine test or production account (production must have
;"MPI-AUSTIN.DOMAIN.EXT" domain for logical link "MPIVA").
;Get logical link IEN for "MPIVA".
;Get domain for "MPIVA" logical link in HL LOGICAL LINK (#870) file.
N RGDOMAIN,RGDMNC S RGDOMAIN=""
D LINK^HLUTIL3("200M",.HLL,"I")
S IEN=$O(HLL(0)) I +IEN>0 S RGDOMAIN=$$GET1^DIQ(870,+IEN_",",.03)
S RGDMNC=$$FIND1^DIC(4.2,"","MQ","MPI-AUSTIN.DOMAIN.EXT") I RGDMNC>0 S RGDMNC=$$GET1^DIQ(4.2,RGDMNC_",",.01)
I RGDOMAIN="" Q
I RGDOMAIN'=RGDMNC W !!,"No data will be transmitted from a TEST account." Q ;Not production; quit SEND.
;
;Transmit e-mail message.
S XMSUB="POINT OF CONTACT CHANGE - SITE "_$P($$SITE^VASITE(),"^",3)
S XMDUZ=DUZ ;name of person editing the option
S XMY("G.MPI/PD POC UPDATE@MPI-AUSTIN.DOMAIN.EXT")=""
S XMTEXT="RGARRAY("
;
S RGARRAY(1)="There has been a change in the point of contact information from"
S RGARRAY(2)=$P($$SITE^VASITE(),"^",2)_" (station number "_$P($$SITE^VASITE(),"^",3)_")."
S RGARRAY(3)=""
D ^XMD
W !!,"Sending information to the MPI/PD Data Management team now.",!
Q
;
END ;Kill variables
K DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,HLL,IEN,RGAD2NFN,RGAD2NNM,RGAD2OFN,RGAD2ONM,RGADMNFN
K RGADMNNM,RGADMOFN,RGADMONM,RGANS,RGARRAY,RGDATA,RGDOMAIN,RGHL2NFN,RGHL2NNM,RGHL2OFN
K RGHL2ONM,RGHL7NFN,RGHL7NNM,RGHL7OFN,RGHL7ONM,RGIR2NFN,RGIR2NNM,RGIR2OFN,RGIR2ONM
K RGIRMNFN,RGIRMNNM,RGIRMOFN,RGIRMONM,RGNUM,RGQUIT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
Q
;
NAME(RGPC,RGFLD) ;Edit IEN of POC from CIRN SITE PARAMETER (#991.8) file.
;RGPC - piece number of POC on the ^RGSITE(991.8,1,"POC" node
;RGFLD - field number of POC to be used in the DR string
;Returns POC IEN before edit^POC IEN after edit OR -1^error message
;
N RGOLDNAM,RGNEWNAM
S RGOLDNAM=$P($G(^RGSITE(991.8,1,"POC")),"^",RGPC)
L +^RGSITE(991.8):10
S DIE="^RGSITE(991.8,",DA=1,DR=RGFLD
D ^DIE K DA,DIE,DR
L -^RGSITE(991.8)
I $D(DTOUT)&(RGOLDNAM="") Q "-1^USER TIMED OUT"
I $D(Y) Q "-1^USER UP-ARROWED OUT"
S RGNEWNAM=$P($G(^RGSITE(991.8,1,"POC")),"^",RGPC)
Q RGOLDNAM_"^"_RGNEWNAM
;
PHONE(RGIEN) ;Edit POC COMMERCIAL PHONE (#.135) from NEW PERSON (#200) file.
;Supported IA #10060 allows read/FileMan for all fields in ^VA(200
;RGIEN - IEN for NEW PERSON for whom phone number is needed
;Returns POC COMMERCIAL PHONE before edit^POC COMMERCIAL PHONE after edit
;
N RGOLDFON,RGNEWFON
S RGOLDFON=$$GET1^DIQ(200,RGIEN,.135)
S RGOLDFON=$TR(RGOLDFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
S RGOLDFON=$TR(RGOLDFON,"()","")
;Edit COMMERCIAL PHONE (#.135), NEW PERSON (#200) file
;IA #2589 allows write/FileMan to field .135 in ^VA(200,
L +^VA(200,RGIEN):10
S DIE="^VA(200,",DA=RGIEN,DR=.135
D ^DIE K DA,DIE,DR
L -^VA(200,RGIEN)
I $D(DTOUT)&(RGOLDFON="") Q "-1^USER TIMED OUT"
I $D(Y) Q "-1^USER UP-ARROWED OUT"
S RGNEWFON=$$GET1^DIQ(200,RGIEN,.135)
S RGNEWFON=$TR(RGNEWFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
S RGNEWFON=$TR(RGNEWFON,"()","")
Q RGOLDFON_"^"_RGNEWFON
;
CNVRTNM(NAME) ;Convert IEN from NEW PERSON (#200) to printable name
;NAME - ien for POC
N RGNAME
I NAME="" Q "<NULL>"
S RGNAME=$$GET1^DIQ(200,NAME,.01)
Q RGNAME
;
ERROR1(RGPOC) ;Write error message 1 for type POC.
W !!,"No "_RGPOC_" Point of Contact identified."
Q
;
ERROR2(RGPOC,RGFLD,RGOLDNAM,RGNEWNAM) ;Write error message 2 for type POC.
W !!,"No "_RGPOC_" Point of Contact phone number identified."
;User timed out or up-arrowed out on phone number.
;Restore name value to original value, if value changed.
I RGOLDNAM=RGNEWNAM K RGFLD,RGOLDNAM,RGNEWNAM,RGPOC Q
L +^RGSITE(991.8):10
S DIE="^RGSITE(991.8,",DA=1,DR=RGFLD_"///^S X=$S(RGOLDNAM="""":""@"",1:RGOLDNAM)"
D ^DIE
L -^RGSITE(991.8)
K DA,DIE,DR,RGFLD,RGOLDNAM
W !,RGPOC_" Point of Contact restored to original value."
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGPOC 7067 printed Dec 13, 2024@01:42:41 Page 2
RGPOC ;BIR/PTD-ADD/EDIT POINT OF CONTACT OPTION ;8/22/01
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**21,24**;30 Apr 99
+2 ;
+3 ;Reference to ^VA(200, supported by IA #2589
+4 ;Reference to LINK^HLUTIL3 and $$GET1^DIQ(870 supported by IA #3335
+5 ;Reference to DOMAIN (#4.2) file supported by IA #3452
+6 ;
INTRO ;Introduction to Option
+1 WRITE @IOF,!,"This option allows you to transmit information to the MPI/PD Data"
+2 WRITE !,"Management team so that the Point of Contact website can be updated."
+3 WRITE !!,"To obtain a list of MPI/PD Points of Contact for each facility,"
+4 WRITE !,"look for the POC web link on the MPI/PD Home Page."
+5 WRITE !!,"The COMMERCIAL PHONE (#.135) field in the NEW PERSON (#200) file"
+6 WRITE !,"will only accept numbers and punctuation, 4-20 characters."
+7 WRITE !!,"Please include the entire phone number:",!,"area code, 7 digit number and extension (e.g., AAA NNN NNNN XXXX)"
+8 WRITE !!,"A contact name without a phone number will NOT be transmitted."
+9 WRITE !," ==="
+10 ;
ASK ;Select POC to add/edit.
+1 WRITE !
KILL DIR
SET DIR(0)="LA^1:7"
+2 SET DIR("A")="Which Point of Contact information do you wish to update? "
+3 SET DIR("A",1)="Select one or more of the following:"
+4 SET DIR("A",2)="(A list or range of numbers can be entered, e.g., 1,3 or 2-4,6.)"
+5 SET DIR("A",3)=""
+6 SET DIR("A",4)=" 1 - Admin POC 2 - Alt Admin POC 3 - IRM POC 4 - Alt IRM POC"
+7 SET DIR("A",5)=" 5 - HL7 POC 6 - Alt HL7 POC 7 - ALL POCs"
+8 SET DIR("A",6)=""
+9 SET DIR("B")="7"
+10 SET DIR("?",1)="Enter:"
+11 SET DIR("?",2)=" ""1"" to add/edit Administrative Point of Contact."
+12 SET DIR("?",3)=" ""2"" to add/edit Alternate Administrative Point of Contact."
+13 SET DIR("?",4)=" ""3"" to add/edit IRM Point of Contact."
+14 SET DIR("?",5)=" ""4"" to add/edit Alternate IRM Point of Contact."
+15 SET DIR("?",6)=" ""5"" to add/edit Health Level Seven Point of Contact."
+16 SET DIR("?",7)=" ""6"" to add/edit Alternate Health Level Seven Point of Contact."
+17 SET DIR("?",8)=" ""7"" to add/edit ALL Points of Contact."
+18 SET DIR("?")=" You can enter a list or range of numbers, e.g., 1,3,5 or 1-3,6."
+19 DO ^DIR
if $DATA(DIRUT)
GOTO END
SET RGANS=$SELECT(Y[7:7,1:Y)
+20 ;
MAIN ;Direct flow based on variable RGANS.
+1 SET RGQUIT=0
+2 IF RGANS["1"
DO POC1^RGPOC1
+3 IF RGANS["2"
DO POC2^RGPOC1
+4 IF RGANS["3"
DO POC3^RGPOC1
+5 IF RGANS["4"
DO POC4^RGPOC1
+6 IF RGANS["5"
DO POC5^RGPOC1
+7 IF RGANS["6"
DO POC6^RGPOC1
+8 IF RGANS="7"
SET (RGADMOFN,RGAD2OFN,RGIRMOFN,RGIR2OFN,RGHL7OFN)=""
Begin DoDot:1
+9 DO POC1^RGPOC1
if RGADMONM=-1
QUIT
if RGADMOFN=-1
QUIT
+10 DO POC2^RGPOC1
if RGAD2ONM=-1
QUIT
if RGAD2OFN=-1
QUIT
+11 DO POC3^RGPOC1
if RGIRMONM=-1
QUIT
if RGIRMOFN=-1
QUIT
+12 DO POC4^RGPOC1
if RGIR2ONM=-1
QUIT
if RGIR2OFN=-1
QUIT
+13 DO POC5^RGPOC1
if RGHL7ONM=-1
QUIT
if RGHL7OFN=-1
QUIT
+14 DO POC6^RGPOC1
End DoDot:1
+15 DO SEND
AGAIN ;Return to selection prompt?
+1 IF RGQUIT=1
DO END
QUIT
+2 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Do you want to add/edit another contact"
+3 DO ^DIR
IF +Y=1
DO END
WRITE @IOF
GOTO ASK
+4 DO END
+5 QUIT
+6 ;
SEND ;Send message to Data Management Team
+1 if '$ORDER(RGARRAY(0))
QUIT
+2 ;Display changed fields.
+3 WRITE @IOF,!,"The following data will be transmitted to the MPI/PD Data Management team.",!
+4 SET RGNUM=0
+5 FOR
SET RGNUM=$ORDER(RGARRAY(RGNUM))
if 'RGNUM
QUIT
WRITE !,RGARRAY(RGNUM)
+6 ;
DOMAIN ;Determine test or production account (production must have
+1 ;"MPI-AUSTIN.DOMAIN.EXT" domain for logical link "MPIVA").
+2 ;Get logical link IEN for "MPIVA".
+3 ;Get domain for "MPIVA" logical link in HL LOGICAL LINK (#870) file.
+4 NEW RGDOMAIN,RGDMNC
SET RGDOMAIN=""
+5 DO LINK^HLUTIL3("200M",.HLL,"I")
+6 SET IEN=$ORDER(HLL(0))
IF +IEN>0
SET RGDOMAIN=$$GET1^DIQ(870,+IEN_",",.03)
+7 SET RGDMNC=$$FIND1^DIC(4.2,"","MQ","MPI-AUSTIN.DOMAIN.EXT")
IF RGDMNC>0
SET RGDMNC=$$GET1^DIQ(4.2,RGDMNC_",",.01)
+8 IF RGDOMAIN=""
QUIT
+9 ;Not production; quit SEND.
IF RGDOMAIN'=RGDMNC
WRITE !!,"No data will be transmitted from a TEST account."
QUIT
+10 ;
+11 ;Transmit e-mail message.
+12 SET XMSUB="POINT OF CONTACT CHANGE - SITE "_$PIECE($$SITE^VASITE(),"^",3)
+13 ;name of person editing the option
SET XMDUZ=DUZ
+14 SET XMY("G.MPI/PD POC UPDATE@MPI-AUSTIN.DOMAIN.EXT")=""
+15 SET XMTEXT="RGARRAY("
+16 ;
+17 SET RGARRAY(1)="There has been a change in the point of contact information from"
+18 SET RGARRAY(2)=$PIECE($$SITE^VASITE(),"^",2)_" (station number "_$PIECE($$SITE^VASITE(),"^",3)_")."
+19 SET RGARRAY(3)=""
+20 DO ^XMD
+21 WRITE !!,"Sending information to the MPI/PD Data Management team now.",!
+22 QUIT
+23 ;
END ;Kill variables
+1 KILL DA,DIC,DIE,DIR,DIRUT,DR,DTOUT,HLL,IEN,RGAD2NFN,RGAD2NNM,RGAD2OFN,RGAD2ONM,RGADMNFN
+2 KILL RGADMNNM,RGADMOFN,RGADMONM,RGANS,RGARRAY,RGDATA,RGDOMAIN,RGHL2NFN,RGHL2NNM,RGHL2OFN
+3 KILL RGHL2ONM,RGHL7NFN,RGHL7NNM,RGHL7OFN,RGHL7ONM,RGIR2NFN,RGIR2NNM,RGIR2OFN,RGIR2ONM
+4 KILL RGIRMNFN,RGIRMNNM,RGIRMOFN,RGIRMONM,RGNUM,RGQUIT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y
+5 QUIT
+6 ;
NAME(RGPC,RGFLD) ;Edit IEN of POC from CIRN SITE PARAMETER (#991.8) file.
+1 ;RGPC - piece number of POC on the ^RGSITE(991.8,1,"POC" node
+2 ;RGFLD - field number of POC to be used in the DR string
+3 ;Returns POC IEN before edit^POC IEN after edit OR -1^error message
+4 ;
+5 NEW RGOLDNAM,RGNEWNAM
+6 SET RGOLDNAM=$PIECE($GET(^RGSITE(991.8,1,"POC")),"^",RGPC)
+7 LOCK +^RGSITE(991.8):10
+8 SET DIE="^RGSITE(991.8,"
SET DA=1
SET DR=RGFLD
+9 DO ^DIE
KILL DA,DIE,DR
+10 LOCK -^RGSITE(991.8)
+11 IF $DATA(DTOUT)&(RGOLDNAM="")
QUIT "-1^USER TIMED OUT"
+12 IF $DATA(Y)
QUIT "-1^USER UP-ARROWED OUT"
+13 SET RGNEWNAM=$PIECE($GET(^RGSITE(991.8,1,"POC")),"^",RGPC)
+14 QUIT RGOLDNAM_"^"_RGNEWNAM
+15 ;
PHONE(RGIEN) ;Edit POC COMMERCIAL PHONE (#.135) from NEW PERSON (#200) file.
+1 ;Supported IA #10060 allows read/FileMan for all fields in ^VA(200
+2 ;RGIEN - IEN for NEW PERSON for whom phone number is needed
+3 ;Returns POC COMMERCIAL PHONE before edit^POC COMMERCIAL PHONE after edit
+4 ;
+5 NEW RGOLDFON,RGNEWFON
+6 SET RGOLDFON=$$GET1^DIQ(200,RGIEN,.135)
+7 SET RGOLDFON=$TRANSLATE(RGOLDFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
+8 SET RGOLDFON=$TRANSLATE(RGOLDFON,"()","")
+9 ;Edit COMMERCIAL PHONE (#.135), NEW PERSON (#200) file
+10 ;IA #2589 allows write/FileMan to field .135 in ^VA(200,
+11 LOCK +^VA(200,RGIEN):10
+12 SET DIE="^VA(200,"
SET DA=RGIEN
SET DR=.135
+13 DO ^DIE
KILL DA,DIE,DR
+14 LOCK -^VA(200,RGIEN)
+15 IF $DATA(DTOUT)&(RGOLDFON="")
QUIT "-1^USER TIMED OUT"
+16 IF $DATA(Y)
QUIT "-1^USER UP-ARROWED OUT"
+17 SET RGNEWFON=$$GET1^DIQ(200,RGIEN,.135)
+18 SET RGNEWFON=$TRANSLATE(RGNEWFON,",./<>?;:'[]\{}|`~!@#$%^&*-_=+"," ")
+19 SET RGNEWFON=$TRANSLATE(RGNEWFON,"()","")
+20 QUIT RGOLDFON_"^"_RGNEWFON
+21 ;
CNVRTNM(NAME) ;Convert IEN from NEW PERSON (#200) to printable name
+1 ;NAME - ien for POC
+2 NEW RGNAME
+3 IF NAME=""
QUIT "<NULL>"
+4 SET RGNAME=$$GET1^DIQ(200,NAME,.01)
+5 QUIT RGNAME
+6 ;
ERROR1(RGPOC) ;Write error message 1 for type POC.
+1 WRITE !!,"No "_RGPOC_" Point of Contact identified."
+2 QUIT
+3 ;
ERROR2(RGPOC,RGFLD,RGOLDNAM,RGNEWNAM) ;Write error message 2 for type POC.
+1 WRITE !!,"No "_RGPOC_" Point of Contact phone number identified."
+2 ;User timed out or up-arrowed out on phone number.
+3 ;Restore name value to original value, if value changed.
+4 IF RGOLDNAM=RGNEWNAM
KILL RGFLD,RGOLDNAM,RGNEWNAM,RGPOC
QUIT
+5 LOCK +^RGSITE(991.8):10
+6 SET DIE="^RGSITE(991.8,"
SET DA=1
SET DR=RGFLD_"///^S X=$S(RGOLDNAM="""":""@"",1:RGOLDNAM)"
+7 DO ^DIE
+8 LOCK -^RGSITE(991.8)
+9 KILL DA,DIE,DR,RGFLD,RGOLDNAM
+10 WRITE !,RGPOC_" Point of Contact restored to original value."
+11 QUIT
+12 ;
