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
