Routine: RGPOC

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

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.",!

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

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."

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."

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGPOC   7067     printed  Feb 18, 2025@23:09:04                                                                                                                                                                                                       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      ;

RGPOC.m