XUESSO1 ;LUKE/SEA Single Sign-on utilities;02/11/10 14:57;08/18/09 14:29
;;8.0;KERNEL;**165,183,196,245,254,269,337,395,466,523**;Jul 10, 1995;Build 19
;Per VHA Directive 2004-038, this routine should not be modified.
;
GET(INDUZ) ;Gather identifying data from user's home site.
;Must have Name, Access&Verify codes, SSN (no pseudo), station name&number
N %,NAME,SITE,SSN,PHONE,X,N,VPID
I '$D(DUZ) G BOMB
I '$D(DUZ(2)) G BOMB
;I '$D(INDUZ) S INDUZ=DUZ
S N=$G(^VA(200,DUZ,0))
I '$L(N) G BOMB
S %=$P(N,U,3) I $L(%)<1 G BOMB ;No Access Code
S %=$P($G(^VA(200,DUZ,.1)),U,2) I $L(%)<1 G BOMB ;No Verify Code
S %=$P(N,U,11) I $L(%)>1,(DT>%) G BOMB ;Terminated
S NAME=$P(N,U)
I '$L(NAME) G BOMB
;
S SITE=$$NS^XUAF4(DUZ(2)) ;Site is name^station#
I $P(SITE,U,2)="" G BOMB ;Need a station number
;
S SSN=$P($G(^VA(200,DUZ,1)),U,9)
I $$SPECIAL($P(SITE,"^",2)) S SSN=999999999 G G4 ;Manila RO doesn't need SSN
I 'SSN G BOMB
;Don't allow if the SSN is pseudo
I $E(SSN,10)="P" G BOMB
;Don't allow if the SSN is not real, (e.g. 00000NNNN)
I $E(SSN,1,5)="00000" G BOMB
;
G4 S PHONE=$$PH
S VPID=$$VPID^XUPS(DUZ) ;(p337)
S X=SSN_U_NAME_U_SITE_U_DUZ
I $L(PHONE)>2&($L(PHONE<20)) S X=X_U_PHONE
S $P(X,U,7)=VPID ;(p337)
;ssn^name^station name^station number^DUZ^phone^vpid
Q X
;
;
BOMB ;Insufficient information to allow visiting
S X="-1^Insufficient User Information On File. ssn,name,station name,station number,DUZ,phone"
Q X
;
;
PH() ; Try for a phone number or pager
N %,X
S %=""
S X=$G(^VA(200,DUZ,.13))
I '$L(X) Q ""
;
S %=$P(X,U,5) I $L(%)>6 Q % ;Commercial #
S %=$P(X,U,2) I $L(%)>2 Q % ;Office
S %=$P(X,U,8) I $L(%)>6 Q % ;Digital Pager
S %=$P(X,U,7) I $L(%)>6 Q % ;Pager
S %=$P(X,U,3) I $L(%)>2 Q % ;Phone #3
S %=$P(X,U,4) I $L(%)>2 Q % ;Phone #4
S %=$P(X,U,1) I $L(%)>2 Q % ;Home Phone
Q "" ;Couldn't find one.
;
SPECIAL(SN) ;Special Manila RO site
Q 358=SN
;
;
PUT(DATIN) ;;Setup data from authenticating site GET() at receiving site
;Return: 0=fail, 1=OK
N NEWDUZ,FDR,TODAY,IEN,DIC,USER,X,%T
N SSN,NAME,SITE,SITENUM,RMTDUZ,PHONE,VPID,XUMF
S U="^",TODAY=$$HTFM^XLFDT($H),DT=$P(TODAY,"."),NEWDUZ=0
K ^TMP("DIERR",$J)
;
S SSN=$P(DATIN,U,1),NAME=$P(DATIN,U,2),SITE=$P(DATIN,U,3)
S SITENUM=$P(DATIN,U,4),RMTDUZ=$P(DATIN,U,5),PHONE=$P(DATIN,U,6)
S VPID=$P(DATIN,U,7) ;(p337)
;Format checks
I NAME'?1U.E1","1U.E Q 0
I SSN'?9N Q 0
I '$L(SITE)!('$L(SITENUM)) Q 0
S XUMF=1 D CHK^DIE(4,99,,SITENUM,.%T) I %T=U Q 0 ;p533
D CHK^DIE(200.06,1,,SITE,.%T) I %T=U Q 0 ;p533
I RMTDUZ'>0 Q 0 ;p337
;
;Get a LOCK. Block if can't get.
L +^VA(200,"HL7"):10 Q:'$T 0
S %T=$$TALL($G(DUZ,0)) L -^VA(200,"HL7")
I %T Q $$SET(NEWDUZ) ;Return 1 if OK.
Q 0
;
;Per PSIM don't load VPID's, Only done by PSIM.
;Code for adding VPID removed in p466.
TALL(DUZ) ;Test for existing user or adds a new one
N FLAG,NEWREC
S FLAG=0,DUZ(0)="@" ;Make sure we can add the entry
;See if match VPID, Per PSIM only use for lookup.
I $L(VPID) D
. S NEWDUZ=+$$IEN^XUPS(VPID) Q:NEWDUZ<1
. I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM
. D UPDT S FLAG=1
. Q
I FLAG Q 1 ;Quit here if we found a match on VPID
;See if the SSN is in the NPF cross reference
I '$$SPECIAL(SITENUM),$D(^VA(200,"SSN",SSN)) D
.S NEWDUZ=$O(^VA(200,"SSN",SSN,0))
.I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM
.D UPDT
.S FLAG=1
.Q
;See if in the AVISIT cross reference
I 'FLAG,$$SPECIAL(SITENUM) D
. S NEWDUZ=$O(^VA(200,"AVISIT",SITENUM,RMTDUZ,0))
. Q:NEWDUZ'>0
. D UPDT S FLAG=1
. Q
I FLAG Q 1 ;Quit here if we found a match for SSN or AVISIT
;
;
;There is no matching SSN, try for a NAME match in "B"
S FLAG=0,NAME=$$UP^XLFSTR(NAME)
I $D(^VA(200,"B",NAME)) D
.N %,USER,USER2
.S NEWDUZ=$O(^VA(200,"B",NAME,0))
.S USER2=$O(^VA(200,"B",NAME,NEWDUZ)) ;More then one?
.Q:$L(USER2)>0
.;
.S %=$P($G(^VA(200,NEWDUZ,1)),U,9)
.Q:%'=SSN ;Don't use this name if it has a different SSN
.;
.I '$L($P(^VA(200,NEWDUZ,1),U,9)) D ADDS
.I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM
.D UPDT S FLAG=1
.Q
I FLAG Q 1 ;Quit here if we found an exact match for NAME (w/o SSN)
;
NEWU ;We didn't find anybody under SSN or NAME so we add a new user
;
S DIC(0)="" ;Turn off ^XUA4A7 (work around)
;
;Put the name in the .01 field first.
D ADDU ;ADDU will set NEWDUZ
;If NEWDUZ is still 0, the User add didn't work so exit.
I NEWDUZ=0 Q 0
; Add SSN and Alias.
D ADDS,ADDA ;(p337)
; Fill in the VISITED FROM multiple
D VISM,UPDT ;Do update for all data in UPDT
;
I $D(^TMP("DIERR",$J)) Q 0 ;FileMan Error
;
I NEWDUZ D BULL Q 1 ;Every thing OK
Q 0 ;Couldn't add user
;
;
; *****Subroutines*****
;
;
SET(NEWDUZ) ;Set the user up to go
Q:NEWDUZ'>0 0
N XUSER,XOPT
S DUZ=NEWDUZ,U="^",DUZ("VISITOR")=SITENUM_U_RMTDUZ ;p533
D DUZ^XUS1A
Q 1
;
ADDU ;Add a new name to the New Person File
N DD,DO,DIC,DA,X,Y
S DIC="^VA(200,",DIC(0)="L",X=NAME,NEWREC=1 ;p533
D FILE^DICN
S:Y>0 NEWDUZ=+Y
Q
;
ADDS ;Add a SSN to the file
Q:$$SPECIAL(SITENUM)
S IEN=NEWDUZ_","
S FDR(200,IEN,9)=SSN
;Do update for all data in UPDT
Q
;
ADDA ;Add a new Alias to file 200.04
Q:$D(^VA(200,NEWDUZ,3,"B","VISITOR"))
S IEN="+2,"_NEWDUZ_","
S FDR("200.04",IEN,.01)="VISITOR"
;Do update for all data in UPDT
Q
;
VISM ;Create a multiple for this site number in the VISTED FROM file
S IEN="+3,"_NEWDUZ_","
S FDR("200.06",IEN,.01)=SITENUM
;
S FDR("200.06",IEN,1)=SITE
S FDR("200.06",IEN,2)=RMTDUZ
S FDR("200.06",IEN,3)=TODAY
;I $D(PHONE),($L(PHONE)>2) S FDR("200.06",IEN,5)=PHONE
;Do update for all data in UPDT
Q
;
UPDT ;Update the LAST VISIT field
I $D(FDR(200.06)) S IEN=$O(FDR(200.06,""))
E S IEN=$O(^VA(200,NEWDUZ,8910,"B",SITENUM,0))_","_NEWDUZ_","
S FDR(200.06,IEN,4)=TODAY
;Update the phone each time
I $D(PHONE),($L(PHONE)>2) S FDR("200.06",IEN,5)=PHONE ;p466
K IEN D UPDATE^DIE("E","FDR","IEN") ;File all the data
I $D(^TMP("DIERR",$J)) D
. N DIK,DA
. D FAIL
. I $D(NEWREC) S DIK="^VA(200,",DA=NEWDUZ D ^DIK ;Remove partial entry ;p533
. S NEWDUZ=0 ;Tell failed
Q
;
BULL ;Set up the bulletin and fire it off, Let MM see if bulletin is there
N XMB
S XMB="XUVISIT"
S XMB(1)=$$FMTE^XLFDT(TODAY)
S XMB(2)=NAME,XMB(3)=NEWDUZ,XMB(4)=SITE
S XMB(5)=SITENUM,XMB(6)=RMTDUZ,XMB(7)=PHONE
D ^XMB
Q
;
FAIL ;Send bulletin if fail to add user.
N I,XMTEXT,XMY,XUTEXT,XMSUB,XMZ,XMMG,ZTQUEUED
S XMSUB="XUESSO-VISIT ADD FAILED",ZTQUEUED=1
D MSG^DIALOG("AEST",.XMTEXT)
S XUTEXT(1)="Attempting to add "_NAME_" from "_SITE
S XUTEXT(2)=$G(DATIN),XUTEXT(3)=" ",XUTEXT=3,I=0
F S I=$O(XMTEXT(I)) Q:'I S XUTEXT=XUTEXT+1,XUTEXT(XUTEXT)=XMTEXT(I)
S XMTEXT="XUTEXT(",XMY("G.XUSVISITFAIL@FO-OAKLAND.MED.VA.GOV")=""
D ^XMD
Q
XUESSO1 ;LUKE/SEA Single Sign-on utilities;02/11/10 14:57;08/18/09 14:29
+1 ;;8.0;KERNEL;**165,183,196,245,254,269,337,395,466,523**;Jul 10, 1995;Build 19
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
GET(INDUZ) ;Gather identifying data from user's home site.
+1 ;Must have Name, Access&Verify codes, SSN (no pseudo), station name&number
+2 NEW %,NAME,SITE,SSN,PHONE,X,N,VPID
+3 IF '$DATA(DUZ)
GOTO BOMB
+4 IF '$DATA(DUZ(2))
GOTO BOMB
+5 ;I '$D(INDUZ) S INDUZ=DUZ
+6 SET N=$GET(^VA(200,DUZ,0))
+7 IF '$LENGTH(N)
GOTO BOMB
+8 ;No Access Code
SET %=$PIECE(N,U,3)
IF $LENGTH(%)<1
GOTO BOMB
+9 ;No Verify Code
SET %=$PIECE($GET(^VA(200,DUZ,.1)),U,2)
IF $LENGTH(%)<1
GOTO BOMB
+10 ;Terminated
SET %=$PIECE(N,U,11)
IF $LENGTH(%)>1
IF (DT>%)
GOTO BOMB
+11 SET NAME=$PIECE(N,U)
+12 IF '$LENGTH(NAME)
GOTO BOMB
+13 ;
+14 ;Site is name^station#
SET SITE=$$NS^XUAF4(DUZ(2))
+15 ;Need a station number
IF $PIECE(SITE,U,2)=""
GOTO BOMB
+16 ;
+17 SET SSN=$PIECE($GET(^VA(200,DUZ,1)),U,9)
+18 ;Manila RO doesn't need SSN
IF $$SPECIAL($PIECE(SITE,"^",2))
SET SSN=999999999
GOTO G4
+19 IF 'SSN
GOTO BOMB
+20 ;Don't allow if the SSN is pseudo
+21 IF $EXTRACT(SSN,10)="P"
GOTO BOMB
+22 ;Don't allow if the SSN is not real, (e.g. 00000NNNN)
+23 IF $EXTRACT(SSN,1,5)="00000"
GOTO BOMB
+24 ;
G4 SET PHONE=$$PH
+1 ;(p337)
SET VPID=$$VPID^XUPS(DUZ)
+2 SET X=SSN_U_NAME_U_SITE_U_DUZ
+3 IF $LENGTH(PHONE)>2&($LENGTH(PHONE<20))
SET X=X_U_PHONE
+4 ;(p337)
SET $PIECE(X,U,7)=VPID
+5 ;ssn^name^station name^station number^DUZ^phone^vpid
+6 QUIT X
+7 ;
+8 ;
BOMB ;Insufficient information to allow visiting
+1 SET X="-1^Insufficient User Information On File. ssn,name,station name,station number,DUZ,phone"
+2 QUIT X
+3 ;
+4 ;
PH() ; Try for a phone number or pager
+1 NEW %,X
+2 SET %=""
+3 SET X=$GET(^VA(200,DUZ,.13))
+4 IF '$LENGTH(X)
QUIT ""
+5 ;
+6 ;Commercial #
SET %=$PIECE(X,U,5)
IF $LENGTH(%)>6
QUIT %
+7 ;Office
SET %=$PIECE(X,U,2)
IF $LENGTH(%)>2
QUIT %
+8 ;Digital Pager
SET %=$PIECE(X,U,8)
IF $LENGTH(%)>6
QUIT %
+9 ;Pager
SET %=$PIECE(X,U,7)
IF $LENGTH(%)>6
QUIT %
+10 ;Phone #3
SET %=$PIECE(X,U,3)
IF $LENGTH(%)>2
QUIT %
+11 ;Phone #4
SET %=$PIECE(X,U,4)
IF $LENGTH(%)>2
QUIT %
+12 ;Home Phone
SET %=$PIECE(X,U,1)
IF $LENGTH(%)>2
QUIT %
+13 ;Couldn't find one.
QUIT ""
+14 ;
SPECIAL(SN) ;Special Manila RO site
+1 QUIT 358=SN
+2 ;
+3 ;
PUT(DATIN) ;;Setup data from authenticating site GET() at receiving site
+1 ;Return: 0=fail, 1=OK
+2 NEW NEWDUZ,FDR,TODAY,IEN,DIC,USER,X,%T
+3 NEW SSN,NAME,SITE,SITENUM,RMTDUZ,PHONE,VPID,XUMF
+4 SET U="^"
SET TODAY=$$HTFM^XLFDT($HOROLOG)
SET DT=$PIECE(TODAY,".")
SET NEWDUZ=0
+5 KILL ^TMP("DIERR",$JOB)
+6 ;
+7 SET SSN=$PIECE(DATIN,U,1)
SET NAME=$PIECE(DATIN,U,2)
SET SITE=$PIECE(DATIN,U,3)
+8 SET SITENUM=$PIECE(DATIN,U,4)
SET RMTDUZ=$PIECE(DATIN,U,5)
SET PHONE=$PIECE(DATIN,U,6)
+9 ;(p337)
SET VPID=$PIECE(DATIN,U,7)
+10 ;Format checks
+11 IF NAME'?1U.E1","1U.E
QUIT 0
+12 IF SSN'?9N
QUIT 0
+13 IF '$LENGTH(SITE)!('$LENGTH(SITENUM))
QUIT 0
+14 ;p533
SET XUMF=1
DO CHK^DIE(4,99,,SITENUM,.%T)
IF %T=U
QUIT 0
+15 ;p533
DO CHK^DIE(200.06,1,,SITE,.%T)
IF %T=U
QUIT 0
+16 ;p337
IF RMTDUZ'>0
QUIT 0
+17 ;
+18 ;Get a LOCK. Block if can't get.
+19 LOCK +^VA(200,"HL7"):10
IF '$TEST
QUIT 0
+20 SET %T=$$TALL($GET(DUZ,0))
LOCK -^VA(200,"HL7")
+21 ;Return 1 if OK.
IF %T
QUIT $$SET(NEWDUZ)
+22 QUIT 0
+23 ;
+24 ;Per PSIM don't load VPID's, Only done by PSIM.
+25 ;Code for adding VPID removed in p466.
TALL(DUZ) ;Test for existing user or adds a new one
+1 NEW FLAG,NEWREC
+2 ;Make sure we can add the entry
SET FLAG=0
SET DUZ(0)="@"
+3 ;See if match VPID, Per PSIM only use for lookup.
+4 IF $LENGTH(VPID)
Begin DoDot:1
+5 SET NEWDUZ=+$$IEN^XUPS(VPID)
IF NEWDUZ<1
QUIT
+6 IF '$DATA(^VA(200,NEWDUZ,8910,"B",SITENUM))
DO VISM
+7 DO UPDT
SET FLAG=1
+8 QUIT
End DoDot:1
+9 ;Quit here if we found a match on VPID
IF FLAG
QUIT 1
+10 ;See if the SSN is in the NPF cross reference
+11 IF '$$SPECIAL(SITENUM)
IF $DATA(^VA(200,"SSN",SSN))
Begin DoDot:1
+12 SET NEWDUZ=$ORDER(^VA(200,"SSN",SSN,0))
+13 IF '$DATA(^VA(200,NEWDUZ,8910,"B",SITENUM))
DO VISM
+14 DO UPDT
+15 SET FLAG=1
+16 QUIT
End DoDot:1
+17 ;See if in the AVISIT cross reference
+18 IF 'FLAG
IF $$SPECIAL(SITENUM)
Begin DoDot:1
+19 SET NEWDUZ=$ORDER(^VA(200,"AVISIT",SITENUM,RMTDUZ,0))
+20 IF NEWDUZ'>0
QUIT
+21 DO UPDT
SET FLAG=1
+22 QUIT
End DoDot:1
+23 ;Quit here if we found a match for SSN or AVISIT
IF FLAG
QUIT 1
+24 ;
+25 ;
+26 ;There is no matching SSN, try for a NAME match in "B"
+27 SET FLAG=0
SET NAME=$$UP^XLFSTR(NAME)
+28 IF $DATA(^VA(200,"B",NAME))
Begin DoDot:1
+29 NEW %,USER,USER2
+30 SET NEWDUZ=$ORDER(^VA(200,"B",NAME,0))
+31 ;More then one?
SET USER2=$ORDER(^VA(200,"B",NAME,NEWDUZ))
+32 IF $LENGTH(USER2)>0
QUIT
+33 ;
+34 SET %=$PIECE($GET(^VA(200,NEWDUZ,1)),U,9)
+35 ;Don't use this name if it has a different SSN
IF %'=SSN
QUIT
+36 ;
+37 IF '$LENGTH($PIECE(^VA(200,NEWDUZ,1),U,9))
DO ADDS
+38 IF '$DATA(^VA(200,NEWDUZ,8910,"B",SITENUM))
DO VISM
+39 DO UPDT
SET FLAG=1
+40 QUIT
End DoDot:1
+41 ;Quit here if we found an exact match for NAME (w/o SSN)
IF FLAG
QUIT 1
+42 ;
NEWU ;We didn't find anybody under SSN or NAME so we add a new user
+1 ;
+2 ;Turn off ^XUA4A7 (work around)
SET DIC(0)=""
+3 ;
+4 ;Put the name in the .01 field first.
+5 ;ADDU will set NEWDUZ
DO ADDU
+6 ;If NEWDUZ is still 0, the User add didn't work so exit.
+7 IF NEWDUZ=0
QUIT 0
+8 ; Add SSN and Alias.
+9 ;(p337)
DO ADDS
DO ADDA
+10 ; Fill in the VISITED FROM multiple
+11 ;Do update for all data in UPDT
DO VISM
DO UPDT
+12 ;
+13 ;FileMan Error
IF $DATA(^TMP("DIERR",$JOB))
QUIT 0
+14 ;
+15 ;Every thing OK
IF NEWDUZ
DO BULL
QUIT 1
+16 ;Couldn't add user
QUIT 0
+17 ;
+18 ;
+19 ; *****Subroutines*****
+20 ;
+21 ;
SET(NEWDUZ) ;Set the user up to go
+1 IF NEWDUZ'>0
QUIT 0
+2 NEW XUSER,XOPT
+3 ;p533
SET DUZ=NEWDUZ
SET U="^"
SET DUZ("VISITOR")=SITENUM_U_RMTDUZ
+4 DO DUZ^XUS1A
+5 QUIT 1
+6 ;
ADDU ;Add a new name to the New Person File
+1 NEW DD,DO,DIC,DA,X,Y
+2 ;p533
SET DIC="^VA(200,"
SET DIC(0)="L"
SET X=NAME
SET NEWREC=1
+3 DO FILE^DICN
+4 IF Y>0
SET NEWDUZ=+Y
+5 QUIT
+6 ;
ADDS ;Add a SSN to the file
+1 IF $$SPECIAL(SITENUM)
QUIT
+2 SET IEN=NEWDUZ_","
+3 SET FDR(200,IEN,9)=SSN
+4 ;Do update for all data in UPDT
+5 QUIT
+6 ;
ADDA ;Add a new Alias to file 200.04
+1 IF $DATA(^VA(200,NEWDUZ,3,"B","VISITOR"))
QUIT
+2 SET IEN="+2,"_NEWDUZ_","
+3 SET FDR("200.04",IEN,.01)="VISITOR"
+4 ;Do update for all data in UPDT
+5 QUIT
+6 ;
VISM ;Create a multiple for this site number in the VISTED FROM file
+1 SET IEN="+3,"_NEWDUZ_","
+2 SET FDR("200.06",IEN,.01)=SITENUM
+3 ;
+4 SET FDR("200.06",IEN,1)=SITE
+5 SET FDR("200.06",IEN,2)=RMTDUZ
+6 SET FDR("200.06",IEN,3)=TODAY
+7 ;I $D(PHONE),($L(PHONE)>2) S FDR("200.06",IEN,5)=PHONE
+8 ;Do update for all data in UPDT
+9 QUIT
+10 ;
UPDT ;Update the LAST VISIT field
+1 IF $DATA(FDR(200.06))
SET IEN=$ORDER(FDR(200.06,""))
+2 IF '$TEST
SET IEN=$ORDER(^VA(200,NEWDUZ,8910,"B",SITENUM,0))_","_NEWDUZ_","
+3 SET FDR(200.06,IEN,4)=TODAY
+4 ;Update the phone each time
+5 ;p466
IF $DATA(PHONE)
IF ($LENGTH(PHONE)>2)
SET FDR("200.06",IEN,5)=PHONE
+6 ;File all the data
KILL IEN
DO UPDATE^DIE("E","FDR","IEN")
+7 IF $DATA(^TMP("DIERR",$JOB))
Begin DoDot:1
+8 NEW DIK,DA
+9 DO FAIL
+10 ;Remove partial entry ;p533
IF $DATA(NEWREC)
SET DIK="^VA(200,"
SET DA=NEWDUZ
DO ^DIK
+11 ;Tell failed
SET NEWDUZ=0
End DoDot:1
+12 QUIT
+13 ;
BULL ;Set up the bulletin and fire it off, Let MM see if bulletin is there
+1 NEW XMB
+2 SET XMB="XUVISIT"
+3 SET XMB(1)=$$FMTE^XLFDT(TODAY)
+4 SET XMB(2)=NAME
SET XMB(3)=NEWDUZ
SET XMB(4)=SITE
+5 SET XMB(5)=SITENUM
SET XMB(6)=RMTDUZ
SET XMB(7)=PHONE
+6 DO ^XMB
+7 QUIT
+8 ;
FAIL ;Send bulletin if fail to add user.
+1 NEW I,XMTEXT,XMY,XUTEXT,XMSUB,XMZ,XMMG,ZTQUEUED
+2 SET XMSUB="XUESSO-VISIT ADD FAILED"
SET ZTQUEUED=1
+3 DO MSG^DIALOG("AEST",.XMTEXT)
+4 SET XUTEXT(1)="Attempting to add "_NAME_" from "_SITE
+5 SET XUTEXT(2)=$GET(DATIN)
SET XUTEXT(3)=" "
SET XUTEXT=3
SET I=0
+6 FOR
SET I=$ORDER(XMTEXT(I))
IF 'I
QUIT
SET XUTEXT=XUTEXT+1
SET XUTEXT(XUTEXT)=XMTEXT(I)
+7 SET XMTEXT="XUTEXT("
SET XMY("G.XUSVISITFAIL@FO-OAKLAND.MED.VA.GOV")=""
+8 DO ^XMD
+9 QUIT
