XUSP557 ;JLI/FO-OAK-INSTALL DATA FOR MDWS APPS IN REMOTE APPLICATION FILE ;05/25/11 09:20
;;8.0;KERNEL;**557**;Jul 10, 1995;Build 11
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; the following is run as a part of the install for patch XU*8*557
ENTRY ; enters the values following tag DATA into file 8994.5
N FDA,FDA1,FDA2,NSET1,NSET2,OFFSET,LINE,XUSIEN1,XUSMSG1,NEW,XUSIEN2,XUSMSG2
; 110217 added to remove entries if already entered, e.g., at test sites, so they can be entered correctly
F OFFSET=1:1 S LINE=$P($T(DATA+OFFSET),";;",2) Q:LINE="" S NEW=$P(LINE,"^") I NEW'="" D
. F XUSIEN2=0:0 S XUSIEN2=$O(^XWB(8994.5,"B",NEW,XUSIEN2)) Q:XUSIEN2'>0 D
. . N DA,DIK S DA=XUSIEN2,DIK="^XWB(8994.5," D ^DIK
. . Q
. Q
; 110217 end of addition
S NSET1=0
F OFFSET=1:1 S LINE=$P($T(DATA+OFFSET),";;",2) Q:LINE="" S NEW=($P(LINE,"^")'="") D
. I NEW S NSET1=NSET1+1,NSET2=0 D ADD1(.FDA1,LINE,NSET1) Q
. S NSET2=NSET2+1 D SET2(.FDA,LINE,NSET1,NSET2)
. Q
D UPDATE^DIE("E","FDA1","XUSIEN1","XUSMSG1")
I $D(XUSMSG1) W !,"ERROR MESSAGES:",! F OFFSET=0:0 S OFFSET=$O(XUSMSG1(OFFSET)) Q:OFFSET'>0 W !," ",XUSMSG1(OFFSET)
D ADD2(.FDA2,.FDA,.XUSIEN1)
; 110310 added to insure OR CPRS GUI CHART gets added correctly to context option
S XUSIEN1=$$FIND1^DIC(19,"","B","MWVS MEDICAL DOMAIN WEB SVCS")
I $G(^DIC(19,XUSIEN1,10,1,0))'>0 D
. S XUSIEN2=$$FIND1^DIC(19,"","B","OR CPRS GUI CHART") Q:XUSIEN2'>0
. K FDA
. ; if already present, but incorrect
. I $D(^DIC(19,XUSIEN1,10,1)) S FDA(19.01,"1,"_XUSIEN1_",",.01)=XUSIEN2 D FILE^DIE("","FDA") I 1
. ; if not already present
. E N NEWIEN S NEWIEN(1)=1 S FDA(19.01,"+1,"_XUSIEN1_",",.01)=XUSIEN2 D UPDATE^DIE("","FDA","NEWIEN","MESSG")
. Q
; end of 110310 insertion
; 110401 need to force NHIN GET VISTA DATA in as an RPC if not there already
S XUSIEN2=$$FIND1^DIC(19.05,","_XUSIEN1_",","B","NHIN GET VISTA DATA")
I XUSIEN2'>0 D
. K FDA S FDA(19.05,"+1,"_XUSIEN1_",",.01)="NHIN GET VISTA DATA"
. D UPDATE^DIE("E","FDA","NEWIEN","MESSG")
. Q
; end of 110401 insertion
Q
;
ADD1(FDA,LINE,SET1) ; build data for primary file entry
; FDA - passed by reference - FileMan data array
; LINE - contains text of current line with data
; SET1 - current data set number for primary file
N IENS S IENS="+"_SET1_","
S FDA(8994.5,IENS,.01)=$P(LINE,"^")
S FDA(8994.5,IENS,.02)=$P(LINE,"^",2)
S FDA(8994.5,IENS,.03)=$P(LINE,"^",3)
Q
;
SET2(FDA,LINE,SET1,SET2) ; capture data for sub-file entry
; FDA - passed by reference - FileMan data array
; LINE - contains text of current line with data
; SET1 - current data set number for primary file
; SET2 - current data set number for sub-file
S FDA(SET1,SET2,.01)=$P(LINE,"^",2)
S FDA(SET1,SET2,.02)=$P(LINE,"^",3)
S FDA(SET1,SET2,.03)=$P(LINE,"^",4)
S FDA(SET1,SET2,.04)=$P(LINE,"^",5)
Q
;
ADD2(FDA2,FDA,IENSVALS) ; build data for sub-file entry
N I,J,FLD,IENS,XUSMSG1,IENS1,OFFSET
F I=1:1 D:$D(FDA2) K FDA2 Q:'$D(FDA(I)) F J=1:1 Q:'$D(FDA(I,J)) S IENS="+"_J_","_IENSVALS(I)_"," F FLD=0:0 S FLD=$O(FDA(I,J,FLD)) Q:FLD'>0 S FDA2(8994.51,IENS,FLD)=FDA(I,J,FLD)
. K XUSMSG1,IENS1
. D UPDATE^DIE("E","FDA2","IENS1","XUSMSG1")
. I $D(XUSMSG1) W !,"ERRORS:",! F OFFSET=0:0 S OFFSET=$O(XUSMSG1(OFFSET)) Q:OFFSET'>0 W !,XUSMSG1(OFFSET)
. Q
Q
;
DATA ;
;;MYHEALTHEVET^MWVS MEDICAL DOMAIN WEB SVCS^41-WAcN_=NSXJ+ok4g_J
;;^H^80^VAAACAPPL.AAC.DVA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;NATIONAL SUICIDE HOTLINE^MWVS MEDICAL DOMAIN WEB SVCS^$wq`WLq(0jWV2f`4xf*
;;^H^80^VHAV08SHS1.V08.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;NATIONAL HOMELESS HOTLINE^MWVS MEDICAL DOMAIN WEB SVCS^cy2jzn)*;U%%3~,0p@4
;;^H^80^VHAV08SHS1.V08.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;NUMI^MWVS MEDICAL DOMAIN WEB SVCS^\8,c,LP$5.qu]l\D@xA$
;;^H^80^VANCRWEBV4.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;^H^80^VANCRWEBV5.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
;;^H^80^VAISHWEBV1.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
;;MOVE^MWVS MEDICAL DOMAIN WEB SVCS^<9-SaNOYLMyTo.=Okk;
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;TBI SCREENING^MWVS MEDICAL DOMAIN WEB SVCS^PvUv9RSQ.9W@FD3DcB_?
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;MEDICAL DOMAIN WEB SERVICES^MWVS MEDICAL DOMAIN WEB SVCS^WHgafhAkItJqu&]Cbp<H
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;PCS ANALYTICS^MWVS MEDICAL DOMAIN WEB SVCS^]y7`bj-T=*Elz6Q#wYM0
;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSP557 5427 printed Apr 09, 2024@21:13:14 Page 2
XUSP557 ;JLI/FO-OAK-INSTALL DATA FOR MDWS APPS IN REMOTE APPLICATION FILE ;05/25/11 09:20
+1 ;;8.0;KERNEL;**557**;Jul 10, 1995;Build 11
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; the following is run as a part of the install for patch XU*8*557
ENTRY ; enters the values following tag DATA into file 8994.5
+1 NEW FDA,FDA1,FDA2,NSET1,NSET2,OFFSET,LINE,XUSIEN1,XUSMSG1,NEW,XUSIEN2,XUSMSG2
+2 ; 110217 added to remove entries if already entered, e.g., at test sites, so they can be entered correctly
+3 FOR OFFSET=1:1
SET LINE=$PIECE($TEXT(DATA+OFFSET),";;",2)
if LINE=""
QUIT
SET NEW=$PIECE(LINE,"^")
IF NEW'=""
Begin DoDot:1
+4 FOR XUSIEN2=0:0
SET XUSIEN2=$ORDER(^XWB(8994.5,"B",NEW,XUSIEN2))
if XUSIEN2'>0
QUIT
Begin DoDot:2
+5 NEW DA,DIK
SET DA=XUSIEN2
SET DIK="^XWB(8994.5,"
DO ^DIK
+6 QUIT
End DoDot:2
+7 QUIT
End DoDot:1
+8 ; 110217 end of addition
+9 SET NSET1=0
+10 FOR OFFSET=1:1
SET LINE=$PIECE($TEXT(DATA+OFFSET),";;",2)
if LINE=""
QUIT
SET NEW=($PIECE(LINE,"^")'="")
Begin DoDot:1
+11 IF NEW
SET NSET1=NSET1+1
SET NSET2=0
DO ADD1(.FDA1,LINE,NSET1)
QUIT
+12 SET NSET2=NSET2+1
DO SET2(.FDA,LINE,NSET1,NSET2)
+13 QUIT
End DoDot:1
+14 DO UPDATE^DIE("E","FDA1","XUSIEN1","XUSMSG1")
+15 IF $DATA(XUSMSG1)
WRITE !,"ERROR MESSAGES:",!
FOR OFFSET=0:0
SET OFFSET=$ORDER(XUSMSG1(OFFSET))
if OFFSET'>0
QUIT
WRITE !," ",XUSMSG1(OFFSET)
+16 DO ADD2(.FDA2,.FDA,.XUSIEN1)
+17 ; 110310 added to insure OR CPRS GUI CHART gets added correctly to context option
+18 SET XUSIEN1=$$FIND1^DIC(19,"","B","MWVS MEDICAL DOMAIN WEB SVCS")
+19 IF $GET(^DIC(19,XUSIEN1,10,1,0))'>0
Begin DoDot:1
+20 SET XUSIEN2=$$FIND1^DIC(19,"","B","OR CPRS GUI CHART")
if XUSIEN2'>0
QUIT
+21 KILL FDA
+22 ; if already present, but incorrect
+23 IF $DATA(^DIC(19,XUSIEN1,10,1))
SET FDA(19.01,"1,"_XUSIEN1_",",.01)=XUSIEN2
DO FILE^DIE("","FDA")
IF 1
+24 ; if not already present
+25 IF '$TEST
NEW NEWIEN
SET NEWIEN(1)=1
SET FDA(19.01,"+1,"_XUSIEN1_",",.01)=XUSIEN2
DO UPDATE^DIE("","FDA","NEWIEN","MESSG")
+26 QUIT
End DoDot:1
+27 ; end of 110310 insertion
+28 ; 110401 need to force NHIN GET VISTA DATA in as an RPC if not there already
+29 SET XUSIEN2=$$FIND1^DIC(19.05,","_XUSIEN1_",","B","NHIN GET VISTA DATA")
+30 IF XUSIEN2'>0
Begin DoDot:1
+31 KILL FDA
SET FDA(19.05,"+1,"_XUSIEN1_",",.01)="NHIN GET VISTA DATA"
+32 DO UPDATE^DIE("E","FDA","NEWIEN","MESSG")
+33 QUIT
End DoDot:1
+34 ; end of 110401 insertion
+35 QUIT
+36 ;
ADD1(FDA,LINE,SET1) ; build data for primary file entry
+1 ; FDA - passed by reference - FileMan data array
+2 ; LINE - contains text of current line with data
+3 ; SET1 - current data set number for primary file
+4 NEW IENS
SET IENS="+"_SET1_","
+5 SET FDA(8994.5,IENS,.01)=$PIECE(LINE,"^")
+6 SET FDA(8994.5,IENS,.02)=$PIECE(LINE,"^",2)
+7 SET FDA(8994.5,IENS,.03)=$PIECE(LINE,"^",3)
+8 QUIT
+9 ;
SET2(FDA,LINE,SET1,SET2) ; capture data for sub-file entry
+1 ; FDA - passed by reference - FileMan data array
+2 ; LINE - contains text of current line with data
+3 ; SET1 - current data set number for primary file
+4 ; SET2 - current data set number for sub-file
+5 SET FDA(SET1,SET2,.01)=$PIECE(LINE,"^",2)
+6 SET FDA(SET1,SET2,.02)=$PIECE(LINE,"^",3)
+7 SET FDA(SET1,SET2,.03)=$PIECE(LINE,"^",4)
+8 SET FDA(SET1,SET2,.04)=$PIECE(LINE,"^",5)
+9 QUIT
+10 ;
ADD2(FDA2,FDA,IENSVALS) ; build data for sub-file entry
+1 NEW I,J,FLD,IENS,XUSMSG1,IENS1,OFFSET
+2 FOR I=1:1
if $DATA(FDA2)
Begin DoDot:1
+3 KILL XUSMSG1,IENS1
+4 DO UPDATE^DIE("E","FDA2","IENS1","XUSMSG1")
+5 IF $DATA(XUSMSG1)
WRITE !,"ERRORS:",!
FOR OFFSET=0:0
SET OFFSET=$ORDER(XUSMSG1(OFFSET))
if OFFSET'>0
QUIT
WRITE !,XUSMSG1(OFFSET)
+6 QUIT
End DoDot:1
KILL FDA2
if '$DATA(FDA(I))
QUIT
FOR J=1:1
if '$DATA(FDA(I,J))
QUIT
SET IENS="+"_J_","_IENSVALS(I)_","
FOR FLD=0:0
SET FLD=$ORDER(FDA(I,J,FLD))
if FLD'>0
QUIT
SET FDA2(8994.51,IENS,FLD)=FDA(I,J,FLD)
+7 QUIT
+8 ;
DATA ;
+1 ;;MYHEALTHEVET^MWVS MEDICAL DOMAIN WEB SVCS^41-WAcN_=NSXJ+ok4g_J
+2 ;;^H^80^VAAACAPPL.AAC.DVA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+3 ;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
+4 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+5 ;;NATIONAL SUICIDE HOTLINE^MWVS MEDICAL DOMAIN WEB SVCS^$wq`WLq(0jWV2f`4xf*
+6 ;;^H^80^VHAV08SHS1.V08.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+7 ;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
+8 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+9 ;;NATIONAL HOMELESS HOTLINE^MWVS MEDICAL DOMAIN WEB SVCS^cy2jzn)*;U%%3~,0p@4
+10 ;;^H^80^VHAV08SHS1.V08.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+11 ;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
+12 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+13 ;;NUMI^MWVS MEDICAL DOMAIN WEB SVCS^\8,c,LP$5.qu]l\D@xA$
+14 ;;^H^80^VANCRWEBV4.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+15 ;;^H^80^VANCRWEBV5.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+16 ;;^H^80^127.0.0.1^/MDWS2/Web/Validate.aspx
+17 ;;^H^80^VAISHWEBV1.VHA.DOMAIN.EXT^/MDWS2/Web/Validate.aspx
+18 ;;MOVE^MWVS MEDICAL DOMAIN WEB SVCS^<9-SaNOYLMyTo.=Okk;
+19 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+20 ;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
+21 ;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+22 ;;TBI SCREENING^MWVS MEDICAL DOMAIN WEB SVCS^PvUv9RSQ.9W@FD3DcB_?
+23 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+24 ;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
+25 ;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+26 ;;MEDICAL DOMAIN WEB SERVICES^MWVS MEDICAL DOMAIN WEB SVCS^WHgafhAkItJqu&]Cbp<H
+27 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+28 ;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
+29 ;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+30 ;;PCS ANALYTICS^MWVS MEDICAL DOMAIN WEB SVCS^]y7`bj-T=*Elz6Q#wYM0
+31 ;;^H^80^VHAANNWEB2.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
+32 ;;^H^80^127.0.0.1^/UserValidation/Validate.aspx
+33 ;;^H^80^VHAANNVISTAWEB.V11.DOMAIN.EXT^/UserValidation/Validate.aspx
