KIDS Distribution saved on Nov 03, 2010@09:17:45 XU 466 **KIDS**:XU*8.0*466^ **INSTALL NAME** XU*8.0*466 "BLD",1017,0) XU*8.0*466^KERNEL^0^3080604^y "BLD",1017,1,0) ^^2^2^3070627^ "BLD",1017,1,1,0) XU*8*466 "Visitor add to NPF update." "BLD",1017,1,2,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",1017,4,0) ^9.64PA^^ "BLD",1017,6) ^420 "BLD",1017,6.3) 9 "BLD",1017,"INID") ^y "BLD",1017,"INIT") POST^XU8P466 "BLD",1017,"KRN",0) ^9.67PA^779.2^20 "BLD",1017,"KRN",.4,0) .4 "BLD",1017,"KRN",.4,"NM",0) ^9.68A^1^1 "BLD",1017,"KRN",.4,"NM",1,0) XUSAP PROXY LIST FILE #200^200^0 "BLD",1017,"KRN",.4,"NM","B","XUSAP PROXY LIST FILE #200",1) "BLD",1017,"KRN",.401,0) .401 "BLD",1017,"KRN",.402,0) .402 "BLD",1017,"KRN",.403,0) .403 "BLD",1017,"KRN",.5,0) .5 "BLD",1017,"KRN",.84,0) .84 "BLD",1017,"KRN",3.6,0) 3.6 "BLD",1017,"KRN",3.8,0) 3.8 "BLD",1017,"KRN",9.2,0) 9.2 "BLD",1017,"KRN",9.8,0) 9.8 "BLD",1017,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",1017,"KRN",9.8,"NM",1,0) XUESSO1^^0^B38935544 "BLD",1017,"KRN",9.8,"NM","B","XUESSO1",1) "BLD",1017,"KRN",19,0) 19 "BLD",1017,"KRN",19.1,0) 19.1 "BLD",1017,"KRN",101,0) 101 "BLD",1017,"KRN",409.61,0) 409.61 "BLD",1017,"KRN",771,0) 771 "BLD",1017,"KRN",779.2,0) 779.2 "BLD",1017,"KRN",870,0) 870 "BLD",1017,"KRN",8989.51,0) 8989.51 "BLD",1017,"KRN",8989.52,0) 8989.52 "BLD",1017,"KRN",8994,0) 8994 "BLD",1017,"KRN","B",.4,.4) "BLD",1017,"KRN","B",.401,.401) "BLD",1017,"KRN","B",.402,.402) "BLD",1017,"KRN","B",.403,.403) "BLD",1017,"KRN","B",.5,.5) "BLD",1017,"KRN","B",.84,.84) "BLD",1017,"KRN","B",3.6,3.6) "BLD",1017,"KRN","B",3.8,3.8) "BLD",1017,"KRN","B",9.2,9.2) "BLD",1017,"KRN","B",9.8,9.8) "BLD",1017,"KRN","B",19,19) "BLD",1017,"KRN","B",19.1,19.1) "BLD",1017,"KRN","B",101,101) "BLD",1017,"KRN","B",409.61,409.61) "BLD",1017,"KRN","B",771,771) "BLD",1017,"KRN","B",779.2,779.2) "BLD",1017,"KRN","B",870,870) "BLD",1017,"KRN","B",8989.51,8989.51) "BLD",1017,"KRN","B",8989.52,8989.52) "BLD",1017,"KRN","B",8994,8994) "BLD",1017,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1017,"QUES",0) ^9.62^^ "BLD",1017,"REQB",0) ^9.611^1^1 "BLD",1017,"REQB",1,0) XU*8.0*395^2 "BLD",1017,"REQB","B","XU*8.0*395",1) "INIT") POST^XU8P466 "KRN",.4,126,-1) 0^1 "KRN",.4,126,0) XUSAP PROXY LIST^3070712.1315^^200^^@^3071002 "KRN",.4,126,"F",1) .01~9.5,.01;L18~9.5,2;"IsPrimary"~S XZ=$$ACTIVE^XUSER(D0);X;"";Z;"S XZ=$$ACTIVE^XUSER(D0)"~ "KRN",.4,126,"F",2) W:DIOO1["CONN" $S(XZ:"Yes",1:"No");"Active";L3;Z;"W:DIOO1["CONN" $S(XZ:"Yes",1:"No")"~ "KRN",.4,126,"H") PROXY USER LIST "MBREQ") 0 "ORD",5,.4) .4;5;;;EDEOUT^DIFROMSO(.4,DA,"",XPDA);FPRE^DIFROMSI(.4,"",XPDA);EPRE^DIFROMSI(.4,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.4,DA,"",XPDA);DEL^DIFROMSK(.4,"",%) "ORD",5,.4,0) PRINT TEMPLATE "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^^0 "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3051215^2970507^.5 "PKG",3,22,1,"PAH",1,0) 466^3080604 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3080604 "PKG",3,22,1,"PAH",1,1,1,0) XU*8*466 "Visitor add to NPF update." "PKG",3,22,1,"PAH",1,1,2,0) Please refer to the Description in the FORUM Patch Module for details. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 2 "RTN","XU8P466") 0^^B689666^n/a "RTN","XU8P466",1,0) XU8P466 ;ISF/RWF - PATCH 466 POST INIT ;06/04/2008 "RTN","XU8P466",2,0) ;;8.0;KERNEL;**466**;Jul 10, 1995;Build 9 "RTN","XU8P466",3,0) Q "RTN","XU8P466",4,0) ; "RTN","XU8P466",5,0) POST ;Post-init "RTN","XU8P466",6,0) Q:$$PATCH^XPDUTL("XU*8.0*466") "RTN","XU8P466",7,0) D BMES^XPDUTL(" Post-Init is removing VPID's. Please wait a minute!") "RTN","XU8P466",8,0) D DEL "RTN","XU8P466",9,0) D BMES^XPDUTL(" Finished removing VPID's") "RTN","XU8P466",10,0) Q "RTN","XU8P466",11,0) ; "RTN","XU8P466",12,0) DEL ;Clean out any VPIDs. "RTN","XU8P466",13,0) N DA,DIC,DIE,DR,VPID,X,Y "RTN","XU8P466",14,0) S VPID="",DIE="^VA(200,",DA=0 "RTN","XU8P466",15,0) F S DA=$O(^VA(200,DA)) Q:'DA I $D(^VA(200,DA,"VPID")) D "RTN","XU8P466",16,0) . S DR="9000///@" D ^DIE "RTN","XU8P466",17,0) . Q "RTN","XU8P466",18,0) Q "RTN","XUESSO1") 0^1^B38935544^B30134233 "RTN","XUESSO1",1,0) XUESSO1 ;LUKE/SEA Single Sign-on utilities; ;2/20/08 09:27 "RTN","XUESSO1",2,0) ;;8.0;KERNEL;**165,183,196,245,254,269,337,395,466**;Jul 10, 1995;Build 9 "RTN","XUESSO1",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUESSO1",4,0) ; "RTN","XUESSO1",5,0) GET(INDUZ) ;Gather identifying data from user's home site. "RTN","XUESSO1",6,0) ;Must have Name, Access&Verify codes, SSN (no pseudo), station name&number "RTN","XUESSO1",7,0) N %,NAME,SITE,SSN,PHONE,X,N,VPID "RTN","XUESSO1",8,0) I '$D(DUZ) G BOMB "RTN","XUESSO1",9,0) I '$D(DUZ(2)) G BOMB "RTN","XUESSO1",10,0) ;I '$D(INDUZ) S INDUZ=DUZ "RTN","XUESSO1",11,0) S N=$G(^VA(200,DUZ,0)) "RTN","XUESSO1",12,0) I '$L(N) G BOMB "RTN","XUESSO1",13,0) S %=$P(N,U,3) I $L(%)<1 G BOMB ;No Access Code "RTN","XUESSO1",14,0) S %=$P($G(^VA(200,DUZ,.1)),U,2) I $L(%)<1 G BOMB ;No Verify Code "RTN","XUESSO1",15,0) S %=$P(N,U,11) I $L(%)>1,(DT>%) G BOMB ;Terminated "RTN","XUESSO1",16,0) S NAME=$P(N,U) "RTN","XUESSO1",17,0) I '$L(NAME) G BOMB "RTN","XUESSO1",18,0) ; "RTN","XUESSO1",19,0) S SITE=$$NS^XUAF4(DUZ(2)) ;Site is name^station# "RTN","XUESSO1",20,0) I $P(SITE,U,2)="" G BOMB ;Need a station number "RTN","XUESSO1",21,0) ; "RTN","XUESSO1",22,0) S SSN=$P($G(^VA(200,DUZ,1)),U,9) "RTN","XUESSO1",23,0) I $$SPECIAL($P(SITE,"^",2)) S SSN=999999999 G G4 ;Manila RO doesn't need SSN "RTN","XUESSO1",24,0) I 'SSN G BOMB "RTN","XUESSO1",25,0) ;Don't allow if the SSN is pseudo "RTN","XUESSO1",26,0) I $E(SSN,10)="P" G BOMB "RTN","XUESSO1",27,0) ;Don't allow if the SSN is not real, (e.g. 00000NNNN) "RTN","XUESSO1",28,0) I $E(SSN,1,5)="00000" G BOMB "RTN","XUESSO1",29,0) ; "RTN","XUESSO1",30,0) G4 S PHONE=$$PH "RTN","XUESSO1",31,0) S VPID=$$VPID^XUPS(DUZ) ;(p337) "RTN","XUESSO1",32,0) S X=SSN_U_NAME_U_SITE_U_DUZ "RTN","XUESSO1",33,0) I $L(PHONE)>2&($L(PHONE<20)) S X=X_U_PHONE "RTN","XUESSO1",34,0) S $P(X,U,7)=VPID ;(p337) "RTN","XUESSO1",35,0) ;ssn^name^station name^station number^DUZ^phone^vpid "RTN","XUESSO1",36,0) Q X "RTN","XUESSO1",37,0) ; "RTN","XUESSO1",38,0) ; "RTN","XUESSO1",39,0) BOMB ;Insufficient information to allow visiting "RTN","XUESSO1",40,0) S X="-1^Insufficient User Information On File. ssn,name,station name,station number,DUZ,phone" "RTN","XUESSO1",41,0) Q X "RTN","XUESSO1",42,0) ; "RTN","XUESSO1",43,0) ; "RTN","XUESSO1",44,0) PH() ; Try for a phone number or pager "RTN","XUESSO1",45,0) N %,X "RTN","XUESSO1",46,0) S %="" "RTN","XUESSO1",47,0) S X=$G(^VA(200,DUZ,.13)) "RTN","XUESSO1",48,0) I '$L(X) Q "" "RTN","XUESSO1",49,0) ; "RTN","XUESSO1",50,0) S %=$P(X,U,5) I $L(%)>6 Q % ;Commercial # "RTN","XUESSO1",51,0) S %=$P(X,U,2) I $L(%)>2 Q % ;Office "RTN","XUESSO1",52,0) S %=$P(X,U,8) I $L(%)>6 Q % ;Digital Pager "RTN","XUESSO1",53,0) S %=$P(X,U,7) I $L(%)>6 Q % ;Pager "RTN","XUESSO1",54,0) S %=$P(X,U,3) I $L(%)>2 Q % ;Phone #3 "RTN","XUESSO1",55,0) S %=$P(X,U,4) I $L(%)>2 Q % ;Phone #4 "RTN","XUESSO1",56,0) S %=$P(X,U,1) I $L(%)>2 Q % ;Home Phone "RTN","XUESSO1",57,0) Q "" ;Couldn't find one. "RTN","XUESSO1",58,0) ; "RTN","XUESSO1",59,0) SPECIAL(SN) ;Special Manila RO site "RTN","XUESSO1",60,0) Q 358=SN "RTN","XUESSO1",61,0) ; "RTN","XUESSO1",62,0) ; "RTN","XUESSO1",63,0) PUT(DATIN) ;;Setup data from authenticating site GET() at receiving site "RTN","XUESSO1",64,0) ;Return: 0=fail, 1=OK "RTN","XUESSO1",65,0) N NEWDUZ,FDR,TODAY,IEN,DIC,USER,X,%T "RTN","XUESSO1",66,0) N SSN,NAME,SITE,SITENUM,RMTDUZ,PHONE,VPID "RTN","XUESSO1",67,0) S U="^",TODAY=$$HTFM^XLFDT($H),DT=$P(TODAY,"."),NEWDUZ=0 "RTN","XUESSO1",68,0) K ^TMP("DIERR",$J) "RTN","XUESSO1",69,0) ; "RTN","XUESSO1",70,0) S SSN=$P(DATIN,U,1),NAME=$P(DATIN,U,2),SITE=$P(DATIN,U,3) "RTN","XUESSO1",71,0) S SITENUM=$P(DATIN,U,4),RMTDUZ=$P(DATIN,U,5),PHONE=$P(DATIN,U,6) "RTN","XUESSO1",72,0) S VPID=$P(DATIN,U,7) ;(p337) "RTN","XUESSO1",73,0) ;Format checks "RTN","XUESSO1",74,0) I NAME'?1U.E1","1U.E Q 0 "RTN","XUESSO1",75,0) I SSN'?9N Q 0 "RTN","XUESSO1",76,0) I '$L(SITE)!('$L(SITENUM)) Q 0 "RTN","XUESSO1",77,0) I RMTDUZ'>0 Q 0 ;p337 "RTN","XUESSO1",78,0) ; "RTN","XUESSO1",79,0) ;Get a LOCK. Block if can't get. "RTN","XUESSO1",80,0) L +^VA(200,"HL7"):10 Q:'$T 0 "RTN","XUESSO1",81,0) S %T=$$TALL($G(DUZ,0)) L -^VA(200,"HL7") "RTN","XUESSO1",82,0) I %T Q $$SET(NEWDUZ) ;Return 1 if OK. "RTN","XUESSO1",83,0) Q 0 "RTN","XUESSO1",84,0) ; "RTN","XUESSO1",85,0) ;Per PSIM don't load VPID's, Only done by PSIM. "RTN","XUESSO1",86,0) ;Code for adding VPID removed in p466. "RTN","XUESSO1",87,0) TALL(DUZ) ;Test for existing user or adds a new one "RTN","XUESSO1",88,0) N FLAG S FLAG=0,DUZ(0)="@" ;Make sure we can add the entry "RTN","XUESSO1",89,0) ;See if match VPID, Per PSIM only use for lookup. "RTN","XUESSO1",90,0) I $L(VPID) D "RTN","XUESSO1",91,0) . S NEWDUZ=+$$IEN^XUPS(VPID) Q:NEWDUZ<1 "RTN","XUESSO1",92,0) . I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM "RTN","XUESSO1",93,0) . D UPDT S FLAG=1 "RTN","XUESSO1",94,0) . Q "RTN","XUESSO1",95,0) I FLAG Q 1 ;Quit here if we found a match on VPID "RTN","XUESSO1",96,0) ;See if the SSN is in the NPF cross reference "RTN","XUESSO1",97,0) I '$$SPECIAL(SITENUM),$D(^VA(200,"SSN",SSN)) D "RTN","XUESSO1",98,0) .S NEWDUZ=$O(^VA(200,"SSN",SSN,0)) "RTN","XUESSO1",99,0) .I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM "RTN","XUESSO1",100,0) .D UPDT "RTN","XUESSO1",101,0) .S FLAG=1 "RTN","XUESSO1",102,0) .Q "RTN","XUESSO1",103,0) ;See if in the AVISIT cross reference "RTN","XUESSO1",104,0) I 'FLAG,$$SPECIAL(SITENUM) D "RTN","XUESSO1",105,0) . S NEWDUZ=$O(^VA(200,"AVISIT",SITENUM,RMTDUZ,0)) "RTN","XUESSO1",106,0) . Q:NEWDUZ'>0 "RTN","XUESSO1",107,0) . D UPDT S FLAG=1 "RTN","XUESSO1",108,0) . Q "RTN","XUESSO1",109,0) I FLAG Q 1 ;Quit here if we found a match for SSN or AVISIT "RTN","XUESSO1",110,0) ; "RTN","XUESSO1",111,0) ; "RTN","XUESSO1",112,0) ;There is no matching SSN, try for a NAME match in "B" "RTN","XUESSO1",113,0) S FLAG=0,NAME=$$UP^XLFSTR(NAME) "RTN","XUESSO1",114,0) I $D(^VA(200,"B",NAME)) D "RTN","XUESSO1",115,0) .N %,USER,USER2 "RTN","XUESSO1",116,0) .S NEWDUZ=$O(^VA(200,"B",NAME,0)) "RTN","XUESSO1",117,0) .S USER2=$O(^VA(200,"B",NAME,NEWDUZ)) ;More then one? "RTN","XUESSO1",118,0) .Q:$L(USER2)>0 "RTN","XUESSO1",119,0) .; "RTN","XUESSO1",120,0) .S %=$P($G(^VA(200,NEWDUZ,1)),U,9) "RTN","XUESSO1",121,0) .Q:%'=SSN ;Don't use this name if it has a different SSN "RTN","XUESSO1",122,0) .; "RTN","XUESSO1",123,0) .I '$L($P(^VA(200,NEWDUZ,1),U,9)) D ADDS "RTN","XUESSO1",124,0) .I '$D(^VA(200,NEWDUZ,8910,"B",SITENUM)) D VISM "RTN","XUESSO1",125,0) .D UPDT S FLAG=1 "RTN","XUESSO1",126,0) .Q "RTN","XUESSO1",127,0) I FLAG Q 1 ;Quit here if we found an exact match for NAME (w/o SSN) "RTN","XUESSO1",128,0) ; "RTN","XUESSO1",129,0) NEWU ;We didn't find anybody under SSN or NAME so we add a new user "RTN","XUESSO1",130,0) ; "RTN","XUESSO1",131,0) S DIC(0)="" ;Turn off ^XUA4A7 (work around) "RTN","XUESSO1",132,0) ; "RTN","XUESSO1",133,0) ;Put the name in the .01 field first. "RTN","XUESSO1",134,0) D ADDU ;ADDU will set NEWDUZ "RTN","XUESSO1",135,0) ;If NEWDUZ is still 0, the User add didn't work so exit. "RTN","XUESSO1",136,0) I NEWDUZ=0 Q 0 "RTN","XUESSO1",137,0) ; Add SSN and Alias. "RTN","XUESSO1",138,0) D ADDS,ADDA ;(p337) "RTN","XUESSO1",139,0) ; Fill in the VISITED FROM multiple "RTN","XUESSO1",140,0) D VISM,UPDT ;Do update for all data in UPDT "RTN","XUESSO1",141,0) ; "RTN","XUESSO1",142,0) I $D(^TMP("DIERR",$J)) Q 0 ;FileMan Error "RTN","XUESSO1",143,0) ; "RTN","XUESSO1",144,0) I NEWDUZ D BULL Q 1 ;Every thing OK "RTN","XUESSO1",145,0) Q 0 ;Couldn't add user "RTN","XUESSO1",146,0) ; "RTN","XUESSO1",147,0) ; "RTN","XUESSO1",148,0) ; *****Subroutines***** "RTN","XUESSO1",149,0) ; "RTN","XUESSO1",150,0) ; "RTN","XUESSO1",151,0) SET(NEWDUZ) ;Set the user up to go "RTN","XUESSO1",152,0) Q:NEWDUZ'>0 0 "RTN","XUESSO1",153,0) N XUSER,XOPT "RTN","XUESSO1",154,0) S DUZ=NEWDUZ,U="^" "RTN","XUESSO1",155,0) D DUZ^XUS1A "RTN","XUESSO1",156,0) Q 1 "RTN","XUESSO1",157,0) ; "RTN","XUESSO1",158,0) ADDU ;Add a new name to the New Person File "RTN","XUESSO1",159,0) N DD,DO,DIC,DA,X,Y "RTN","XUESSO1",160,0) S DIC="^VA(200,",DIC(0)="L",X=NAME "RTN","XUESSO1",161,0) D FILE^DICN "RTN","XUESSO1",162,0) S:Y>0 NEWDUZ=+Y "RTN","XUESSO1",163,0) Q "RTN","XUESSO1",164,0) ; "RTN","XUESSO1",165,0) ADDS ;Add a SSN to the file "RTN","XUESSO1",166,0) Q:$$SPECIAL(SITENUM) "RTN","XUESSO1",167,0) S IEN=NEWDUZ_"," "RTN","XUESSO1",168,0) S FDR(200,IEN,9)=SSN "RTN","XUESSO1",169,0) ;Do update for all data in UPDT "RTN","XUESSO1",170,0) Q "RTN","XUESSO1",171,0) ; "RTN","XUESSO1",172,0) ADDA ;Add a new Alias to file 200.04 "RTN","XUESSO1",173,0) Q:$D(^VA(200,NEWDUZ,3,"B","VISITOR")) "RTN","XUESSO1",174,0) S IEN="+2,"_NEWDUZ_"," "RTN","XUESSO1",175,0) S FDR("200.04",IEN,.01)="VISITOR" "RTN","XUESSO1",176,0) ;Do update for all data in UPDT "RTN","XUESSO1",177,0) Q "RTN","XUESSO1",178,0) ; "RTN","XUESSO1",179,0) VISM ;Create a multiple for this site number in the VISTED FROM file "RTN","XUESSO1",180,0) S IEN="+3,"_NEWDUZ_"," "RTN","XUESSO1",181,0) S FDR("200.06",IEN,.01)=SITENUM "RTN","XUESSO1",182,0) ; "RTN","XUESSO1",183,0) S FDR("200.06",IEN,1)=SITE "RTN","XUESSO1",184,0) S FDR("200.06",IEN,2)=RMTDUZ "RTN","XUESSO1",185,0) S FDR("200.06",IEN,3)=TODAY "RTN","XUESSO1",186,0) ;I $D(PHONE),($L(PHONE)>2) S FDR("200.06",IEN,5)=PHONE "RTN","XUESSO1",187,0) ;Do update for all data in UPDT "RTN","XUESSO1",188,0) Q "RTN","XUESSO1",189,0) ; "RTN","XUESSO1",190,0) UPDT ;Update the LAST VISIT field "RTN","XUESSO1",191,0) I $D(FDR(200.06)) S IEN=$O(FDR(200.06,"")) "RTN","XUESSO1",192,0) E S IEN=$O(^VA(200,NEWDUZ,8910,"B",SITENUM,0))_","_NEWDUZ_"," "RTN","XUESSO1",193,0) S FDR(200.06,IEN,4)=TODAY "RTN","XUESSO1",194,0) ;Update the phone each time "RTN","XUESSO1",195,0) I $D(PHONE),($L(PHONE)>2) S FDR("200.06",IEN,5)=PHONE ;p466 "RTN","XUESSO1",196,0) K IEN D UPDATE^DIE("E","FDR","IEN") ;File all the data "RTN","XUESSO1",197,0) I $D(^TMP("DIERR",$J)) D "RTN","XUESSO1",198,0) . N DIK,DA "RTN","XUESSO1",199,0) . D FAIL "RTN","XUESSO1",200,0) . S DIK="^VA(200,",DA=NEWDUZ D ^DIK ;Remove partial entry "RTN","XUESSO1",201,0) . S NEWDUZ=0 ;Tell failed "RTN","XUESSO1",202,0) Q "RTN","XUESSO1",203,0) ; "RTN","XUESSO1",204,0) BULL ;Set up the bulletin and fire it off, Let MM see if bulletin is there "RTN","XUESSO1",205,0) N XMB "RTN","XUESSO1",206,0) S XMB="XUVISIT" "RTN","XUESSO1",207,0) S XMB(1)=$$FMTE^XLFDT(TODAY) "RTN","XUESSO1",208,0) S XMB(2)=NAME,XMB(3)=NEWDUZ,XMB(4)=SITE "RTN","XUESSO1",209,0) S XMB(5)=SITENUM,XMB(6)=RMTDUZ,XMB(7)=PHONE "RTN","XUESSO1",210,0) D ^XMB "RTN","XUESSO1",211,0) Q "RTN","XUESSO1",212,0) ; "RTN","XUESSO1",213,0) FAIL ;Send bulletin if fail to add user. "RTN","XUESSO1",214,0) N I,XMTEXT,XMY,XUTEXT,XMSUB,XMZ,XMMG,ZTQUEUED "RTN","XUESSO1",215,0) S XMSUB="XUESSO-VISIT ADD FAILED",ZTQUEUED=1 "RTN","XUESSO1",216,0) D MSG^DIALOG("AEST",.XMTEXT) "RTN","XUESSO1",217,0) S XUTEXT(1)="Attempting to add "_NAME_" from "_SITE "RTN","XUESSO1",218,0) S XUTEXT(2)=$G(DATIN),XUTEXT(3)=" ",XUTEXT=3,I=0 "RTN","XUESSO1",219,0) F S I=$O(XMTEXT(I)) Q:'I S XUTEXT=XUTEXT+1,XUTEXT(XUTEXT)=XMTEXT(I) "RTN","XUESSO1",220,0) S XMTEXT="XUTEXT(",XMY("G.XUSVISITFAIL@FO-OAKLAND.MED.VA.GOV")="" "RTN","XUESSO1",221,0) D ^XMD "RTN","XUESSO1",222,0) Q "VER") 8.0^22.0 **END** **END**