- DG53644P ;BPFO/JRC - Home Telehealth Patient POST Install;10 January 2005 ; 4/8/08 10:02am
- ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- ;
- EN ;Main entry point
- ;Init variables
- N VIEIP,LINK,DGARRAY,SITE,FLAG,RESPONSE
- S DGARRAY="^TMP(""DGHT"",$J,""IPARRAY"")"
- S SITE=+$P($$SITE^VASITE(),U,3),(LINK,RESPONSE)=0
- ;
- ;Setup ip address array
- D ARRAY
- ;
- ;Resolve ip address to use
- S VIEIP="",VIEIP=$O(@DGARRAY@(SITE,VIEIP))
- ;
- ;No ip address resolved, enter manually? if flag = 1 abort
- I VIEIP="" D ASKYN I 'RESPONSE D ERRMSG K @DGARRAY Q
- ;
- ;If response = 1, enter ip adress manually if flag = 1 abort
- I RESPONSE S VIEIP=0 D ASKIP I 'VIEIP D ERRMSG K @DGARRAY Q
- ;
- ;Order thru HL Logical Link file and retrieve IEN for 'DGHT' Link
- S LINK=$O(^HLCS(870,"B","DG HTH",LINK))
- ;
- ;If DG HTH logical link not found display message and quit
- I 'LINK K @DGARRAY D ERRMSG Q
- ;
- ;Update HL Logical Link file (#870)
- D BMES^XPDUTL("DG HTH Logical Link has been found ")
- D BMES^XPDUTL("Updating IP Address field (#400.01) ")
- I VIEIP D
- .;Prepare DIE filer call
- .N DGHFDA,DGHERR
- .S DGHFDA(870,LINK_",",400.01)=VIEIP
- .D FILE^DIE("EK","DGHFDA","DGHERR")
- .I $D(DGHERR) D ERRMSG Q
- .D BMES^XPDUTL("DG HTH Logical Link ip address updated successfully. ")
- D MENUS
- Q
- ;
- ARRAY ;Set VIE IP Address Array
- ;Input : DGARRAY - ip address array
- ;Output : VIE ip address array
- ; @DGARRAY@(station,VieIpAddress) = ""
- N OFF,TEXT,STATION,IP
- F OFF=1:1 S TEXT=$P($T(TABLE+OFF),";;",2) Q:TEXT="END" D
- .S STATION=$P(TEXT,"^",1),IP=$P(TEXT,"^",2)
- .I STATION=""!(IP="") Q
- .S @DGARRAY@(STATION,IP)=""
- Q
- ;
- ASKIP ;Prompt user for VIE IP address
- N DIR,DIRUT,X,Y
- S DIR(0)="F^^K:X'?1.3N1"".""1.3N1"".""1.3N1"".""1.3N X"
- S DIR("?",1)="Enter a valid IP address using the following format: nnn.nnn.nnn.nnn"
- S DIR("?")="Or '??' for a list of available station numbers & IP addresses."
- S DIR("??")="^D VIEHELP^DG53644P"
- S DIR("A")="Enter local VIE IP address"
- D ^DIR
- I $D(DIRUT) Q
- S VIEIP=Y
- Q
- ;
- VIEHELP ;Help text listing Local VIE address"
- N OFF,TEXT,IP
- F OFF=1:1 S TEXT=$P($T(TABLE+OFF),";;",2) Q:TEXT="END" D
- .S STATION=$P(TEXT,"^",1),IP=$P(TEXT,"^",2)
- .I STATION=""!(IP="") Q
- .W ?3,STATION,?12,IP,!
- Q
- ASKYN ;Ask user if they want to enter IP address manually
- N DIR,DIRUT,X,Y
- S DIR(0)="Y"
- S DIR("A",1)="Unable to resolve VIE IP address."
- S DIR("A")="Would you like to enter it manually"
- D ^DIR
- I $D(DIRUT)!('Y) S FLAG=1 Q
- S RESPONSE=Y
- Q
- ;
- ERRMSG ;Problem encountered updating IP address notify user
- D BMES^XPDUTL("DG HTH Logical Link's IP address was not updated. ")
- D MES^XPDUTL("See patch description for instructions on how ")
- D MES^XPDUTL("to update the IP address at a later time. ")
- Q
- ;
- N OPTION,MENU,TEXT
- ;Delete HTH main menu from registration options.
- S OPTION="DGHT HOME TELEHEALTH"
- F MENU="DG REGISTRATION MENU","DG SUPERVISOR MENU" D
- .D DELETE^XPDMENU(MENU,OPTION)
- D BMES^XPDUTL("Implementation of HTH requires OCC coordination/approval; hence the following")
- D BMES^XPDUTL("list of HTH menu options have been placed out of order by the installation.")
- S OPTION="",TEXT="Activation of option requires OCC approval."
- F OPTION="DGHT HOME TELEHEALTH","DGHT PATIENT SIGNUP","DGHT PATIENT INACTIVATION","DGHT SUMMARY REPORT","DGHT TRANSMISSION REPORT" D
- .D OUT^XPDMENU(OPTION,TEXT)
- .D BMES^XPDUTL("["_OPTION_"]")
- Q
- TABLE ;VIE IP address array table syntax - station ^ vie ip
- ;;516^10.64.10.136
- ;;660^10.154.2.54
- ;;657^10.123.139.63
- ;;613^10.40.106.46
- ;;528^10.21.253.165
- ;;HEC^10.61.193.83
- ;;528^10.21.253.169
- ;;HEC^10.61.193.88
- ;;688^10.41.0.18
- ;;518^10.8.66.64
- ;;523^10.9.0.99
- ;;650^10.11.1.30
- ;;689^10.12.8.37
- ;;580^10.133.188.116
- ;;517^10.50.50.24
- ;;608^10.8.143.73
- ;;561^10.30.21.175
- ;;503^10.32.11.27
- ;;558^10.48.138.44
- ;;402^10.14.128.29
- ;;620^10.30.21.180
- ;;529^10.32.129.50
- ;;589^10.120.137.84
- ;;526^10.30.21.185
- ;;512^10.42.14.165
- ;;637^10.50.148.34
- ;;540^10.33.120.113
- ;;542^10.34.22.100
- ;;674^10.137.10.30
- ;;671^10.140.159.107
- ;;504^10.145.252.221
- ;;630^10.30.21.165
- ;;405^10.14.55.53
- ;;562^10.33.184.77
- ;;659^10.51.1.122
- ;;632^10.30.21.170
- ;;595^10.35.136.65
- ;;460^10.39.10.30
- ;;565^10.51.138.130
- ;;658^10.49.138.24
- ;;646^10.37.34.86
- ;;590^10.48.10.89
- ;;509^10.57.224.115
- ;;521^10.59.15.164
- ;;534^10.56.224.105
- ;;631^10.13.97.24
- ;;693^10.38.14.110
- ;;652^10.49.50.60
- ;;544^10.60.205.80
- ;;557^10.61.224.94
- ;;673^10.69.48.45
- ;;642^10.36.41.66
- ;;619^10.62.224.103
- ;;679^10.63.224.238
- ;;573^10.65.10.44
- ;;672^10.68.130.68
- ;;546^10.67.12.49
- ;;581^10.73.100.123
- ;;596^10.74.100.123
- ;;614^10.76.100.124
- ;;757^10.81.1.96
- ;;548^10.70.31.219
- ;;603^10.75.100.123
- ;;626^10.78.100.123
- ;;538^10.82.1.249
- ;;621^10.72.100.123
- ;;539^10.80.2.46
- ;;583^10.89.4.94
- ;;541^10.83.1.69
- ;;610^10.90.1.40
- ;;552^10.85.1.29
- ;;550^10.94.10.133
- ;;506^10.93.80.134
- ;;695^10.98.2.38
- ;;515^10.92.1.85
- ;;537^10.97.8.33
- ;;676^10.103.2.132
- ;;553^10.91.0.74
- ;;578^10.101.1.64
- ;;556^10.100.1.18
- ;;607^10.102.2.65
- ;;655^10.88.63.68
- ;;502^10.129.24.29
- ;;598^10.128.5.226
- ;;586^10.130.12.207
- ;;585^10.99.1.67
- ;;520^10.132.96.24
- ;;564^10.134.10.116
- ;;623^10.134.140.38
- ;;629^10.131.90.19
- ;;635^10.135.56.118
- ;;667^10.129.131.82
- ;;519^10.146.252.103
- ;;501^10.144.252.224
- ;;644^10.148.253.60
- ;;442^10.152.21.79
- ;;756^10.147.252.224
- ;;649^10.149.252.225
- ;;554^10.153.5.154
- ;;436^10.154.132.68
- ;;678^10.150.253.218
- ;;575^10.155.134.45
- ;;654^10.172.25.11
- ;;640^10.168.99.38
- ;;459^10.170.100.74
- ;;612^10.173.19.113
- ;;666^10.152.183.178
- ;;531^10.167.138.66
- ;;648^10.165.50.99
- ;;663^10.161.5.50
- ;;653^10.166.130.147
- ;;668^10.163.14.34
- ;;463^10.162.140.63
- ;;687^10.163.144.27
- ;;692^10.167.4.52
- ;;358^10.171.253.13
- ;;570^10.171.67.160
- ;;662^10.174.1.79
- ;;605^10.177.118.81
- ;;593^10.176.50.24
- ;;618^10.104.10.89
- ;;ALBANY^10.1.19.150
- ;;600^10.179.99.94
- ;;ALBANY CS LAB^10.1.19.155
- ;;SILVER SPRING^10.2.29.172
- ;;664^10.178.10.73
- ;;691^10.180.1.48
- ;;508^10.58.239.74
- ;;HDR AAC^10.224.132.23
- ;;HDR AAC^10.224.132.28
- ;;AAC^10.224.151.133
- ;;AAC^10.224.151.153
- ;;BAY PINES OIFO^10.4.229.88
- ;;HINES OIFO^10.3.21.43
- ;;BIRMINGHAM OIFO^10.4.21.25
- ;;SALT LAKE OIFO^10.5.21.86
- ;;BAY PINES OIFO IV&V TEST LAB^10.4.229.85
- ;;HINES OIFO EMC DATA CENTER^10.3.21.48
- ;;HAC^10.6.21.42
- ;;HAC^10.191.10.152
- ;;IE Team - Dev & Test^10.4.229.90
- ;;EMC Data Center^10.3.21.53
- ;;IE Team - Dev & Test^10.6.21.50
- ;;MPI^10.224.151.138
- ;;CMOP^10.189.77.163
- ;;CMOP^10.189.101.157
- ;;CMOP^10.189.1.17
- ;;CMOP^10.189.61.94
- ;;636^10.114.5.4
- ;;CMOP^10.189.101.34
- ;;CMOP^10.189.77.74
- ;;CMOP^10.189.37.38
- ;;549^10.138.65.55
- ;;ARC^10.191.1.58
- ;;PLANO TEST SERVER^10.6.208.19
- ;;541^10.83.59.125
- ;;END
- DG53644P ;BPFO/JRC - Home Telehealth Patient POST Install;10 January 2005 ; 4/8/08 10:02am
- +1 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20
- +2 ;
- EN ;Main entry point
- +1 ;Init variables
- +2 NEW VIEIP,LINK,DGARRAY,SITE,FLAG,RESPONSE
- +3 SET DGARRAY="^TMP(""DGHT"",$J,""IPARRAY"")"
- +4 SET SITE=+$PIECE($$SITE^VASITE(),U,3)
- SET (LINK,RESPONSE)=0
- +5 ;
- +6 ;Setup ip address array
- +7 DO ARRAY
- +8 ;
- +9 ;Resolve ip address to use
- +10 SET VIEIP=""
- SET VIEIP=$ORDER(@DGARRAY@(SITE,VIEIP))
- +11 ;
- +12 ;No ip address resolved, enter manually? if flag = 1 abort
- +13 IF VIEIP=""
- DO ASKYN
- IF 'RESPONSE
- DO ERRMSG
- KILL @DGARRAY
- QUIT
- +14 ;
- +15 ;If response = 1, enter ip adress manually if flag = 1 abort
- +16 IF RESPONSE
- SET VIEIP=0
- DO ASKIP
- IF 'VIEIP
- DO ERRMSG
- KILL @DGARRAY
- QUIT
- +17 ;
- +18 ;Order thru HL Logical Link file and retrieve IEN for 'DGHT' Link
- +19 SET LINK=$ORDER(^HLCS(870,"B","DG HTH",LINK))
- +20 ;
- +21 ;If DG HTH logical link not found display message and quit
- +22 IF 'LINK
- KILL @DGARRAY
- DO ERRMSG
- QUIT
- +23 ;
- +24 ;Update HL Logical Link file (#870)
- +25 DO BMES^XPDUTL("DG HTH Logical Link has been found ")
- +26 DO BMES^XPDUTL("Updating IP Address field (#400.01) ")
- +27 IF VIEIP
- Begin DoDot:1
- +28 ;Prepare DIE filer call
- +29 NEW DGHFDA,DGHERR
- +30 SET DGHFDA(870,LINK_",",400.01)=VIEIP
- +31 DO FILE^DIE("EK","DGHFDA","DGHERR")
- +32 IF $DATA(DGHERR)
- DO ERRMSG
- QUIT
- +33 DO BMES^XPDUTL("DG HTH Logical Link ip address updated successfully. ")
- End DoDot:1
- +34 DO MENUS
- +35 QUIT
- +36 ;
- ARRAY ;Set VIE IP Address Array
- +1 ;Input : DGARRAY - ip address array
- +2 ;Output : VIE ip address array
- +3 ; @DGARRAY@(station,VieIpAddress) = ""
- +4 NEW OFF,TEXT,STATION,IP
- +5 FOR OFF=1:1
- SET TEXT=$PIECE($TEXT(TABLE+OFF),";;",2)
- IF TEXT="END"
- QUIT
- Begin DoDot:1
- +6 SET STATION=$PIECE(TEXT,"^",1)
- SET IP=$PIECE(TEXT,"^",2)
- +7 IF STATION=""!(IP="")
- QUIT
- +8 SET @DGARRAY@(STATION,IP)=""
- End DoDot:1
- +9 QUIT
- +10 ;
- ASKIP ;Prompt user for VIE IP address
- +1 NEW DIR,DIRUT,X,Y
- +2 SET DIR(0)="F^^K:X'?1.3N1"".""1.3N1"".""1.3N1"".""1.3N X"
- +3 SET DIR("?",1)="Enter a valid IP address using the following format: nnn.nnn.nnn.nnn"
- +4 SET DIR("?")="Or '??' for a list of available station numbers & IP addresses."
- +5 SET DIR("??")="^D VIEHELP^DG53644P"
- +6 SET DIR("A")="Enter local VIE IP address"
- +7 DO ^DIR
- +8 IF $DATA(DIRUT)
- QUIT
- +9 SET VIEIP=Y
- +10 QUIT
- +11 ;
- VIEHELP ;Help text listing Local VIE address"
- +1 NEW OFF,TEXT,IP
- +2 FOR OFF=1:1
- SET TEXT=$PIECE($TEXT(TABLE+OFF),";;",2)
- IF TEXT="END"
- QUIT
- Begin DoDot:1
- +3 SET STATION=$PIECE(TEXT,"^",1)
- SET IP=$PIECE(TEXT,"^",2)
- +4 IF STATION=""!(IP="")
- QUIT
- +5 WRITE ?3,STATION,?12,IP,!
- End DoDot:1
- +6 QUIT
- ASKYN ;Ask user if they want to enter IP address manually
- +1 NEW DIR,DIRUT,X,Y
- +2 SET DIR(0)="Y"
- +3 SET DIR("A",1)="Unable to resolve VIE IP address."
- +4 SET DIR("A")="Would you like to enter it manually"
- +5 DO ^DIR
- +6 IF $DATA(DIRUT)!('Y)
- SET FLAG=1
- QUIT
- +7 SET RESPONSE=Y
- +8 QUIT
- +9 ;
- ERRMSG ;Problem encountered updating IP address notify user
- +1 DO BMES^XPDUTL("DG HTH Logical Link's IP address was not updated. ")
- +2 DO MES^XPDUTL("See patch description for instructions on how ")
- +3 DO MES^XPDUTL("to update the IP address at a later time. ")
- +4 QUIT
- +5 ;
- +1 NEW OPTION,MENU,TEXT
- +2 ;Delete HTH main menu from registration options.
- +3 SET OPTION="DGHT HOME TELEHEALTH"
- +4 FOR MENU="DG REGISTRATION MENU","DG SUPERVISOR MENU"
- Begin DoDot:1
- +5 DO DELETE^XPDMENU(MENU,OPTION)
- End DoDot:1
- +6 DO BMES^XPDUTL("Implementation of HTH requires OCC coordination/approval; hence the following")
- +7 DO BMES^XPDUTL("list of HTH menu options have been placed out of order by the installation.")
- +8 SET OPTION=""
- SET TEXT="Activation of option requires OCC approval."
- +9 FOR OPTION="DGHT HOME TELEHEALTH","DGHT PATIENT SIGNUP","DGHT PATIENT INACTIVATION","DGHT SUMMARY REPORT","DGHT TRANSMISSION REPORT"
- Begin DoDot:1
- +10 DO OUT^XPDMENU(OPTION,TEXT)
- +11 DO BMES^XPDUTL("["_OPTION_"]")
- End DoDot:1
- +12 QUIT
- TABLE ;VIE IP address array table syntax - station ^ vie ip
- +1 ;;516^10.64.10.136
- +2 ;;660^10.154.2.54
- +3 ;;657^10.123.139.63
- +4 ;;613^10.40.106.46
- +5 ;;528^10.21.253.165
- +6 ;;HEC^10.61.193.83
- +7 ;;528^10.21.253.169
- +8 ;;HEC^10.61.193.88
- +9 ;;688^10.41.0.18
- +10 ;;518^10.8.66.64
- +11 ;;523^10.9.0.99
- +12 ;;650^10.11.1.30
- +13 ;;689^10.12.8.37
- +14 ;;580^10.133.188.116
- +15 ;;517^10.50.50.24
- +16 ;;608^10.8.143.73
- +17 ;;561^10.30.21.175
- +18 ;;503^10.32.11.27
- +19 ;;558^10.48.138.44
- +20 ;;402^10.14.128.29
- +21 ;;620^10.30.21.180
- +22 ;;529^10.32.129.50
- +23 ;;589^10.120.137.84
- +24 ;;526^10.30.21.185
- +25 ;;512^10.42.14.165
- +26 ;;637^10.50.148.34
- +27 ;;540^10.33.120.113
- +28 ;;542^10.34.22.100
- +29 ;;674^10.137.10.30
- +30 ;;671^10.140.159.107
- +31 ;;504^10.145.252.221
- +32 ;;630^10.30.21.165
- +33 ;;405^10.14.55.53
- +34 ;;562^10.33.184.77
- +35 ;;659^10.51.1.122
- +36 ;;632^10.30.21.170
- +37 ;;595^10.35.136.65
- +38 ;;460^10.39.10.30
- +39 ;;565^10.51.138.130
- +40 ;;658^10.49.138.24
- +41 ;;646^10.37.34.86
- +42 ;;590^10.48.10.89
- +43 ;;509^10.57.224.115
- +44 ;;521^10.59.15.164
- +45 ;;534^10.56.224.105
- +46 ;;631^10.13.97.24
- +47 ;;693^10.38.14.110
- +48 ;;652^10.49.50.60
- +49 ;;544^10.60.205.80
- +50 ;;557^10.61.224.94
- +51 ;;673^10.69.48.45
- +52 ;;642^10.36.41.66
- +53 ;;619^10.62.224.103
- +54 ;;679^10.63.224.238
- +55 ;;573^10.65.10.44
- +56 ;;672^10.68.130.68
- +57 ;;546^10.67.12.49
- +58 ;;581^10.73.100.123
- +59 ;;596^10.74.100.123
- +60 ;;614^10.76.100.124
- +61 ;;757^10.81.1.96
- +62 ;;548^10.70.31.219
- +63 ;;603^10.75.100.123
- +64 ;;626^10.78.100.123
- +65 ;;538^10.82.1.249
- +66 ;;621^10.72.100.123
- +67 ;;539^10.80.2.46
- +68 ;;583^10.89.4.94
- +69 ;;541^10.83.1.69
- +70 ;;610^10.90.1.40
- +71 ;;552^10.85.1.29
- +72 ;;550^10.94.10.133
- +73 ;;506^10.93.80.134
- +74 ;;695^10.98.2.38
- +75 ;;515^10.92.1.85
- +76 ;;537^10.97.8.33
- +77 ;;676^10.103.2.132
- +78 ;;553^10.91.0.74
- +79 ;;578^10.101.1.64
- +80 ;;556^10.100.1.18
- +81 ;;607^10.102.2.65
- +82 ;;655^10.88.63.68
- +83 ;;502^10.129.24.29
- +84 ;;598^10.128.5.226
- +85 ;;586^10.130.12.207
- +86 ;;585^10.99.1.67
- +87 ;;520^10.132.96.24
- +88 ;;564^10.134.10.116
- +89 ;;623^10.134.140.38
- +90 ;;629^10.131.90.19
- +91 ;;635^10.135.56.118
- +92 ;;667^10.129.131.82
- +93 ;;519^10.146.252.103
- +94 ;;501^10.144.252.224
- +95 ;;644^10.148.253.60
- +96 ;;442^10.152.21.79
- +97 ;;756^10.147.252.224
- +98 ;;649^10.149.252.225
- +99 ;;554^10.153.5.154
- +100 ;;436^10.154.132.68
- +101 ;;678^10.150.253.218
- +102 ;;575^10.155.134.45
- +103 ;;654^10.172.25.11
- +104 ;;640^10.168.99.38
- +105 ;;459^10.170.100.74
- +106 ;;612^10.173.19.113
- +107 ;;666^10.152.183.178
- +108 ;;531^10.167.138.66
- +109 ;;648^10.165.50.99
- +110 ;;663^10.161.5.50
- +111 ;;653^10.166.130.147
- +112 ;;668^10.163.14.34
- +113 ;;463^10.162.140.63
- +114 ;;687^10.163.144.27
- +115 ;;692^10.167.4.52
- +116 ;;358^10.171.253.13
- +117 ;;570^10.171.67.160
- +118 ;;662^10.174.1.79
- +119 ;;605^10.177.118.81
- +120 ;;593^10.176.50.24
- +121 ;;618^10.104.10.89
- +122 ;;ALBANY^10.1.19.150
- +123 ;;600^10.179.99.94
- +124 ;;ALBANY CS LAB^10.1.19.155
- +125 ;;SILVER SPRING^10.2.29.172
- +126 ;;664^10.178.10.73
- +127 ;;691^10.180.1.48
- +128 ;;508^10.58.239.74
- +129 ;;HDR AAC^10.224.132.23
- +130 ;;HDR AAC^10.224.132.28
- +131 ;;AAC^10.224.151.133
- +132 ;;AAC^10.224.151.153
- +133 ;;BAY PINES OIFO^10.4.229.88
- +134 ;;HINES OIFO^10.3.21.43
- +135 ;;BIRMINGHAM OIFO^10.4.21.25
- +136 ;;SALT LAKE OIFO^10.5.21.86
- +137 ;;BAY PINES OIFO IV&V TEST LAB^10.4.229.85
- +138 ;;HINES OIFO EMC DATA CENTER^10.3.21.48
- +139 ;;HAC^10.6.21.42
- +140 ;;HAC^10.191.10.152
- +141 ;;IE Team - Dev & Test^10.4.229.90
- +142 ;;EMC Data Center^10.3.21.53
- +143 ;;IE Team - Dev & Test^10.6.21.50
- +144 ;;MPI^10.224.151.138
- +145 ;;CMOP^10.189.77.163
- +146 ;;CMOP^10.189.101.157
- +147 ;;CMOP^10.189.1.17
- +148 ;;CMOP^10.189.61.94
- +149 ;;636^10.114.5.4
- +150 ;;CMOP^10.189.101.34
- +151 ;;CMOP^10.189.77.74
- +152 ;;CMOP^10.189.37.38
- +153 ;;549^10.138.65.55
- +154 ;;ARC^10.191.1.58
- +155 ;;PLANO TEST SERVER^10.6.208.19
- +156 ;;541^10.83.59.125
- +157 ;;END